home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 7: Sunsite / Linux Cubed Series 7 - Sunsite Vol 1.iso / system / status / omnimoni.0 / omnimoni / OmniMoni / src / omnimoni.tcl
Encoding:
Text File  |  1995-11-12  |  86.7 KB  |  2,723 lines
  1. ### $Id: omnimoni.tcl,v 1.0 1995/11/12 06:00:48 rvm Exp rvm $
  2. ### $Author: rvm $
  3. ### OmniMoni verion:  $Revision: 1.0 $
  4.  
  5. ###############################################################################
  6. ###############################################################################
  7. ##
  8. ## OmniMoni is a highly configurable, realtime, information monitoring system.
  9. ## OmniMoni, Copyright (C) 1995  Rainer Mager
  10. ##
  11. ## This program is free software; you can redistribute it and/or modify it
  12. ## under the terms of the GNU General Public License as published by the Free
  13. ## Software Foundation; either version 2 of the License, or (at your option)
  14. ## any later version.
  15. ##
  16. ## This program is distributed in the hope that it will be useful, but WITHOUT
  17. ## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  18. ## FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
  19. ## more details.
  20. ##
  21. ## You should have received a copy of the GNU General Public License along with
  22. ## this program; if not, write to the Free Software Foundation, Inc., 675 Mass
  23. ## Ave, Cambridge, MA 02139, USA.
  24. ##
  25. ###############################################################################
  26. ###############################################################################
  27. ##
  28. ## Notes:
  29. ##
  30. ## - This file works best with a tab size of 4 and a window width of 100.
  31. ## - All global variables have their initital letter capitalized and use an
  32. ##   underbar to seperate words.
  33. ## - Boolean types and global counters have all letters capatalized.
  34. ## - All of my "procedures" have their initial letter capitalized.
  35. ##
  36. ###############################################################################
  37. ###############################################################################
  38.  
  39.  
  40.  
  41. #######################
  42. ### Procedure list: ###
  43. #######################
  44. ###
  45. ##################
  46. ### Error handling
  47. ##################
  48. ### tkerror        - Handle miscellaneous tk errors.  Hopefully, this'll never get called.
  49. ### MyCatch        - Catch executing a procedure and do something with a possible error message.
  50. ### CheckColor     - Check if a given color is a recognized one.
  51. ###
  52. #############
  53. ### Functions
  54. #############
  55. ### IndentLine     - Indent a line any number of times.
  56. ### VarSub         - Check a string for variables and if any exist go through substituting them.
  57. ### AbsSort        - Compare two numbers' absolute values.
  58. ### SortPackArray  - Sort an array of arrays according to a value in the inner array.
  59. ### SetDebug       - Set the debug level given an integer.
  60. ###
  61. #########
  62. ### Input
  63. #########
  64. ### LoadConfigFile - Load in the configuration file.
  65. ### GetENVs        - Check and get any of the environmental variables that are recognized.
  66. ### GetCLAs        - Check the command line arguments for the one's I want and maybe print help.
  67. ###
  68. ##########
  69. ### Output
  70. ##########
  71. ### Blurb          - Print a message to the terminal while doing word wrap.
  72. ### Debug          - Check debug level and maybe print a message.
  73. ###
  74. ##################
  75. ### Initialization
  76. ##################
  77. ### DoGlobals      - Initialize those global variables that require initial values.
  78. ### InitAll        - Initialize everything and then begin.
  79. ###
  80. ############
  81. ### Creation
  82. ############
  83. ### ParseTop       - Recursive procedure to check the top level and do initial pass stuff on it.
  84. ### ParseWindow    - Parse a WINDOW section of the config file.
  85. ### ParseConfigure - Change any global configuration options in the config file.
  86. ### ParseGroup     - Parse a GROUP section of the config file.
  87. ### ParseLabel     - Parse a LABEL section of the config file.
  88. ### ParseGraph     - Parse a GRAPH section of a config file.
  89. ### ParsePlot      - Parse a PLOT section of the config file.
  90. ### CreateWidgets  - Recursively create all widgets in a given WINDOW.
  91. ### CreateLabel    - Create a text label (message).
  92. ### DoBinds        - Put some bindings on a given window.
  93. ###
  94. ################
  95. ### User Event Driven
  96. ################
  97. ### DemandUpdate   - Cause widget (and all ancestors) to do an update immediately.
  98. ### TogglePack     - Toggle unpacked or packed state of a widget.
  99. ### ToggleIconify  - Toggle a WINDOW iconified or not.
  100. ### TogglePlot     - Toggle showing or not showing, a line in a graph.
  101. ### Unpack         - Unpack a widget and remember who it was packed after before being unpacked.
  102. ### Repack         - Repack and unpacked widget back to where it was originally.
  103. ###
  104. #####################
  105. ### Time Event Driven
  106. #####################
  107. ### UpdateSeconds  - Update everything and then wait the update time and do it again.
  108. ### UpdateWidgets  - Recursively update all widgets in a given WINDOW.
  109. ### UpdatePlot     - Update all PLOT lines in a GRAPH.
  110. ### EvalSpecial    - Evaluate the special symbols in a dynamic label or a graph.
  111. ###
  112. ############
  113. ### Graphics
  114. ############
  115. ### ScrollCanvas   - Scroll the graph with the left mouse button.
  116. ### ReHash         - Redraw all hash marks to new scale of graph.
  117.  
  118.  
  119.  
  120. ######################
  121. ######################
  122. ### Error Handling ###
  123. ######################
  124. ######################
  125.  
  126. #########################################################################
  127. ### Handle miscellaneous tk errors.  Hopefully, this'll never get called.
  128.  
  129. proc tkerror { err_msg } {
  130.     Blurb "Warning: a Tk error occurred, program execution will continue." -9
  131.     Debug 16 "\nThe actual Tk error was:\n$err_msg\n"
  132. }
  133.  
  134. ### END tkerror
  135. ###############
  136.  
  137.  
  138. ###############################################################################
  139. ### Catch executing a procedure and do something with a possible error message.
  140.  
  141. proc MyCatch { command err_msg } {
  142.     global Substitutes
  143.     if {[catch $command out]} {
  144.         # if there was an error
  145.         Debug 16 "The actual error message was:\n\n$out\n\n"
  146.         switch [string index $err_msg [expr [string length $err_msg] - 1]] {
  147.             "!" {
  148.                 # display just my error message with 7 spaces for "Error: "
  149.                 Blurb $err_msg -7
  150.                 exit 1
  151.             }
  152.             ":" {
  153.                 # display my and Tk's error messages with 0
  154.                 Blurb "$err_msg  $out" -7
  155.                 exit 1
  156.             }
  157.         }
  158.         # not critical so just display just my error message with 9 spaced for "Warning: "
  159.         Blurb $err_msg -9
  160.     }
  161.     return $out
  162. }
  163.  
  164. ### END MyCatch
  165. ###############
  166.  
  167.  
  168. ###############################################
  169. ### Check if a given color is a recognized one.
  170.  
  171. proc CheckColor { color } {
  172.     # this probably isn't terribly efficient, but I don't know of another way to do it
  173.     frame .dummy-test-frame
  174.     set error [catch ".dummy-test-frame config -background $color"]
  175.     destroy .dummy-test-frame
  176.     return $error
  177. }
  178.  
  179. ### END CheckColor
  180. ##################
  181.  
  182.  
  183.  
  184. #################
  185. #################
  186. ### Functions ###
  187. #################
  188. #################
  189.  
  190. ######################################
  191. ### Indent a line any number of times.
  192.  
  193. proc IndentLine { indent } {
  194.     global Indent_Chars
  195.     for {set temp 0} {$temp < $indent} {incr temp} {
  196.         puts -nonewline $Indent_Chars
  197.     }
  198. }
  199.  
  200. ### END IndentLine
  201. ##################
  202.  
  203.  
  204. ###############################################################################
  205. ### Check a string for variables and if any exist go through substituting them.
  206.  
  207. proc VarSub { string } {
  208.     global Substitutes
  209.     set to_return ""
  210.     while {[regexp -indices {\$[A-Z]} $string index]} {
  211.         # while there are more variables
  212.         if {[string index $string [expr [lindex $index 0] - 1]] == "/"} {
  213.             # if it is backslash quoted
  214.             append to_return [string range $string 0 [lindex $index 1]]
  215.             set string [string range $string [expr [lindex $index 1] + 1] end]
  216.         } else {
  217.             set begin [lindex $index 0]
  218.             set count $begin
  219.             while {[regexp {[A-Z]} [string index $string [incr count]]]} {
  220.                 # while more letters in this one do nothing
  221.             }
  222.             set end [expr $count - 1]
  223.             set var_name [string range $string [expr $begin + 1] $end]
  224.             if {[info exists Substitutes($var_name)]} {
  225.                 # remember what's before variable
  226.                 append to_return [string range $string 0 [expr $begin - 1]]
  227.                 # remember variable
  228.                 append to_return $Substitutes($var_name)
  229.                 # reset to rest for next check
  230.                 set string [string range $string [expr $end + 1] end]
  231.             } else {
  232.                 Blurb "Error: variable ``$var_name'' referenced with no definition!" -7
  233.                 exit 1
  234.             }
  235.         }
  236.     }
  237.     append to_return $string
  238.     return $to_return
  239. }
  240.  
  241. ### END VarSub
  242. ##############
  243.  
  244.  
  245. #########################################
  246. ### Compare two numbers' absolute values.
  247.  
  248. proc AbsSort { first second } {
  249.     set first [expr abs([lindex $first 0])]
  250.     set second [expr abs([lindex $second 0])]
  251.     if {$first == $second} {
  252.         return 0
  253.     } elseif {$first > $second} {
  254.         return 1
  255.     } else {
  256.         return -1
  257.     }
  258. }
  259.  
  260. ### END AbsSort
  261. ###############
  262.  
  263.  
  264. ####################################################################
  265. ### Sort an array of arrays according to a value in the inner array.
  266.  
  267. proc SortPackArray { first second } {
  268.     global sort_variable
  269.     # this has to be a second global command to get the first value
  270.     global [set sort_variable]
  271.     if {[set [set sort_variable]($first)] < [set [set sort_variable]($second)]} {
  272.         return -1
  273.     } elseif {[set [set sort_variable]($first)] > [set [set sort_variable]($second)]} {
  274.         return 1
  275.     } else {
  276.         return 0
  277.     }
  278. }
  279.  
  280. ### END SortPackArray
  281. #####################
  282.  
  283.  
  284. #########################################
  285. ### Set the debug level given an integer.
  286.  
  287. proc SetDebug { mode } {
  288.     global Debug
  289.     # calculate the new debug mode
  290.     set Debug [expr $Debug ^ 1<<[expr $mode - 1]]
  291.     Blurb "Debug mode set to $Debug." 0
  292. }
  293.  
  294. ### END SetDebug
  295. ################
  296.  
  297.  
  298.  
  299. #############
  300. #############
  301. ### Input ###
  302. #############
  303. #############
  304.  
  305. ###################################
  306. ### Load in the configuration file.
  307.  
  308. proc LoadConfigFile { file_name } {
  309.     if {[file readable $file_name]} {
  310.         # if file is readable
  311.         set file [open $file_name]
  312.         while {![eof $file]} {
  313.             # read the next 1k block
  314.             append temp [read $file 1024]
  315.         }
  316.         close $file
  317.         return $temp
  318.     } else {
  319.         Blurb "Error: could not find or read the file ``$file_name''!" -7
  320.         exit 1
  321.     }
  322. }
  323.  
  324. ### END LoadConfigFile
  325. ######################
  326.  
  327.  
  328. #########################################################################
  329. ### Check and get any of the environmental variables that are recognized.
  330.  
  331. proc GetENVs {} {
  332.     global OmniConfigFile Indent_Chars Update_Delta env LIB_PATH
  333.     foreach var "OMNIMONI_CONFIG OMNIMONI_INDENT OMNIMONI_UPDATE" {
  334.         if {[info exists env($var)]} {
  335.             switch $var {
  336.                 OMNIMONI_CONFIG {
  337.                     set OmniConfigFile $env(OMNIMONI_CONFIG)
  338.                 }
  339.                 OMNIMONI_INDENT {
  340.                     set Indent_Chars $env(OMNIMONI_INDENT)
  341.                 }
  342.                 OMNIMONI_UPDATE {
  343.                     set Update_Delta $env(OMNIMONI_UPDATE)
  344.                 }
  345.                 OMNIMONI_LIB {
  346.                     # where the GIFs are
  347.                     set LIB_PATH $env(OMNIMONI_LIB)
  348.                 }
  349.             }
  350.         }
  351.     }
  352. }
  353.  
  354. ### END GetENVs
  355. ###############
  356.  
  357.  
  358. ###############################################################################
  359. ### Check the command line arguments for the one's I want and maybe print help.
  360.  
  361. proc GetCLAs {} {
  362.     global argv0 argc argv Debug Update_Delta OmniConfigFile Indent_Chars OM_title \
  363.             Iconify OM_legal1 OM_legal2 Substitutes
  364.     if {$argc > 0} {
  365.         # if there are any args
  366.         for {set count 0} {$count < $argc} {incr count} {
  367.             # go through them all
  368.             switch -- [lindex $argv $count] {
  369.                 --assign -
  370.                 -a {
  371.                     set var_name [lindex $argv [incr count]]
  372.                     if {[regexp {[^A-Z]} $var_name]} {
  373.                         Blurb "Warning: variable names must only contain capital letter, \
  374.                                 ignoring ``$var_name''." -9
  375.                         incr count
  376.                     } else {
  377.                         set Substitutes($var_name) [lindex $argv [incr count]]
  378.                         Debug 32 "Variable ``$var_name'' set to ``$Substitutes($var_name)''.\n"
  379.                     }
  380.                 }
  381.                 --verbose -
  382.                 -v {
  383.                     if {![catch "expr [lindex $argv [incr count]] + 1"]} {
  384.                         # if it's a number
  385.                         set Debug [lindex $argv $count]
  386.                     } else {
  387.                         Blurb "Warning:  tried to set Debug level to non-number, ignoring!" -9
  388.                     }
  389.                 }
  390.                 --indent -
  391.                 -i {
  392.                     set Indent_Chars [lindex $argv [incr count]]
  393.                 }
  394.                 --file -
  395.                 -f {
  396.                     set OmniConfigFile [lindex $argv [incr count]]
  397.                 }
  398.                 --update -
  399.                 -u {
  400.                     if {[catch "expr [lindex $argv [incr count]] + 1"]} {
  401.                         Blurb "Warning: tried to set UPDATE to non-number, ignoring!" -9
  402.                     } else {
  403.                         set Update_Delta [lindex $argv $count]
  404.                         if {!($Update_Delta > 0)} {
  405.                             set Update_Delta 1
  406.                             Blurb "Warning: UPDATE must be positive, setting to 1!" -9
  407.                         }
  408.                     }
  409.                 }
  410.                 --iconify -
  411.                 -c {
  412.                     set Iconify 1
  413.                 }
  414.                 --help {
  415.                     Blurb $OM_legal1 9
  416.                     Blurb $OM_legal2 9
  417.                     Blurb "" 0
  418.                     Blurb "Usage: $argv0 \[<-a variable value> <-d #> <-i string> <-f filename> \
  419.                             <-u seconds> --help -l --debug\]" 7
  420.                     Blurb "" 0
  421.                     Blurb "-a var val .. assign ``val'' to variable ``var'' to be substituted \
  422.                             in the configuration file" 14
  423.                     Blurb "-v 0-255 .... or'd verbosity level(s) out of possible 8 \[0\]" 14
  424.                     Blurb "-i string ... characters used for indents during debugging \[four \
  425.                             spaces\]" 14
  426.                     Blurb "-f file ..... use ``file'' instead of the default \[~/.omnimoni\]" 14
  427.                     Blurb "-u time ..... seconds between checks for updates \[1\]" 14
  428.                     Blurb "-c .......... flag to iconify main window on startup \[off\]" 14
  429.                     Blurb "--help ...... show this help information" 14
  430.                     Blurb "--debug ..... show what the -v verbosity level mean" 14
  431.                     Blurb "-l .......... show legal notices about the program" 14
  432.                     exit 0
  433.                 }
  434.                 --debug {
  435.                     Blurb $OM_legal1 9
  436.                     Blurb $OM_legal2 9
  437.                     Blurb "" 1
  438.                     Blurb "OmniMoni supports 255 different verbose settings that can be helpful \
  439.                             when debugging your configuration file.  Specifically there are 8 \
  440.                             different settings which can be used in any combination with each \
  441.                             other.  The total verbosity level is determined by thinking of each \
  442.                             setting as a bit, setting 1 being the least significant bit and \
  443.                             setting 8 a as the most significant." 0
  444.                     Blurb "" 0
  445.                     Blurb "The settings supported are:" 0
  446.                     Blurb "" 0
  447.                     Blurb "1 - Display what is parsed in the configuration file as it happens." 4
  448.                     Blurb "2 - Display what values are being set for the various widgets." 4
  449.                     Blurb "3 - Set all labels as static instead of calculating thier values." 4
  450.                     Blurb "4 - Display what is packed and unpacked as it happens." 4
  451.                     Blurb "5 - Display actual Tk error messages when they occur." 4
  452.                     Blurb "6 - Display variable substitutions and default settings." 4
  453.                     Blurb "7 - Make all widgets appear as they are created instead all at once \
  454.                             at the end." 4
  455.                     Blurb "8 - Display what is happening during updates." 4
  456.                     Blurb "" 0
  457.                     Blurb "Note that some of these settings, 1 and 8, can produce a lot of output \
  458.                             to the point where it will probably slow down program execution. \
  459.                             Also, using option 3 will cause GRAPHs to stop updating." 0
  460.                     Blurb "" 0
  461.                     Blurb "These setting can be changed interactively by pressing CONTROL-\# \
  462.                             where \# is the number of the level to toggle." 0
  463.                     exit 0
  464.                 }
  465.                 --legal -
  466.                 -l {
  467.                     Blurb "OmniMoni is a highly configurable, realtime, information monitoring \
  468.                             system. OmniMoni, Copyright (C) 1995  Rainer Mager" 0
  469.                     Blurb "" 0
  470.                     Blurb "This program is free software; you can redistribute it and/or modify \
  471.                             it under the terms of the GNU General Public License as published by \
  472.                             the Free Software Foundation; either version 2 of the License, or \
  473.                             (at your option) any later version." 0
  474.                     Blurb "" 0
  475.                     Blurb "This program is distributed in the hope that it will be useful, but \
  476.                             WITHOUT ANY WARRANTY; without even the implied warranty of \
  477.                             MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU \
  478.                             General Public License for more details." 0
  479.                     Blurb "" 0
  480.                     Blurb "You should have received a copy of the GNU General Public License \
  481.                             along with this program; if not, write to the Free Software \
  482.                             Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA." 0
  483.                     exit 0
  484.                 }
  485.                 default {
  486.                     Blurb $OM_legal1 -9
  487.                     Blurb $OM_legal2 -9
  488.                     Blurb "" -1
  489.                     Blurb "Unknown option: [lindex $argv $count]" -16
  490.                     Blurb "" -1
  491.                     Blurb "Usage: $argv0 \[<-a variable value> <-v #> <-i string> <-f filename> \
  492.                             <-u seconds> -c --help -l --debug\]" -7
  493.                     exit 1
  494.                 }
  495.             }
  496.         }
  497.     }
  498. }
  499.  
  500. ### END GetCLAs
  501. ###############
  502.  
  503.  
  504.  
  505. ##############
  506. ##############
  507. ### Output ###
  508. ##############
  509. ##############
  510.  
  511.  
  512. ###########################################################
  513. ### Print a message to the terminal while doing word wrap.
  514.  
  515. proc Blurb { message indent } {
  516.     if {![catch {set size [exec stty size]}]} {
  517.         # if the stty command worked
  518.         set columns [lindex $size 1]
  519.     } else {
  520.         set columns 80
  521.     }
  522.     # a little margin for readability
  523.     incr columns -2
  524.     set line ""
  525.     set space ""
  526.     for {set i 0} {$i < abs($indent)} {incr i} {
  527.         # generate the string of spaces for indention
  528.         set space "$space "
  529.     }
  530.     set error [catch {
  531.         # first we need to back-slash quote all double quotes
  532.         set temp $message
  533.         regsub \" $temp \\\" message
  534.         # now do the word wrapping
  535.         foreach word $message {
  536.             if {[string length $line] + [string length $word] < $columns} {
  537.                 set line "$line$word "
  538.             } else {
  539.                 if {$indent < 0} {
  540.                     # if it's negative then stderr
  541.                     puts stderr $line
  542.                 } else {
  543.                     # else to stdout
  544.                     puts $line
  545.                 }
  546.                 set line "$space$word "
  547.             }
  548.         }
  549.     }]
  550.     if {$error} {
  551.         Blurb "Error: confusing syntax problem, check braces and quotes!" -7
  552.         exit 1
  553.     }
  554.     puts $line
  555. }
  556.  
  557. ### END Blurb
  558. #############
  559.  
  560.  
  561. ################################################
  562. ### Check debug level and maybe print a message.
  563.  
  564. proc Debug { level string } {
  565.     global Debug Indent
  566.     # Debug levels are:
  567.     # 1 - displays what is being done while parsing the config file
  568.     # 2 - displays the values that are assigned to each field
  569.     # 4 - makes all labels static and displays the label code instead of the result in the widgets
  570.     # 8 - displays what widgets are Unpacked and Repacked
  571.     # 16 - displays actual Tk error messages
  572.     # 32 - displays variable substitutions and defaults
  573.     # 64 - pack during creation, not after all created
  574.     # 128 - shows what is happening during updates
  575.     if {$string != {}} {
  576.         # if there is a string given
  577.         if {$Debug & $level} {
  578.             # if the level bit is set on
  579.             if {$level == 1 || $level == 128} {
  580.                 # these two debug levels need special text formatting
  581.                 if {[string first ">---<" $string] != -1} {
  582.                     puts -nonewline $string
  583.                 } elseif {[set first_half [string first "->" $string]] > 0} {
  584.                     # if there is a "->" in the string
  585.                     puts -nonewline [string range $string 0 $first_half]
  586.                     puts -nonewline [format "%3d>" [incr Indent]]
  587.                     puts -nonewline [string range $string [expr $first_half + 2] end]
  588.                 } elseif {[set first_half [string first "<-" $string]] > 0} {
  589.                     # elseif there is a "<-" in the string
  590.                     puts -nonewline [string range $string 0 $first_half]
  591.                     puts -nonewline [format "%3d-" $Indent]
  592.                     puts -nonewline [string range $string [expr $first_half + 2] end]
  593.                     incr Indent -1
  594.                 } else {
  595.                     Blurb "This message should never be seen (2)!" 0
  596.                 }
  597.             } elseif {$level == 2} {
  598.                 # this debug level is also special
  599.                 set start 0
  600.                 while {[string match {*.*=*} $string] == 1} {
  601.                     # if the format is "string1.string2=string3"
  602.                     set begin [expr [string first "." $string] + 1]
  603.                     incr start $begin
  604.                     set string [string range $string $begin end]
  605.                 }
  606.                 puts [IndentLine $Indent]$string
  607.             } else {
  608.                 # else nothing special in string
  609.                 puts -nonewline $string
  610.             }
  611.         }
  612.     } else {
  613.         # else not a string so just return whether level was set or not
  614.         return [expr $Debug & $level]
  615.     }
  616. }
  617.  
  618. ### END Debug
  619. #############
  620.  
  621.  
  622.  
  623. ######################
  624. ######################
  625. ### Initialization ###
  626. ######################
  627. ######################
  628.  
  629. #################################################################
  630. ### Initialize those global variables that require initial values.
  631.  
  632. proc DoGlobals {} {
  633.     global OM_title OM_legal1 OM_legal2 LIB_PATH
  634.     set revision {$Revision: 1.0 $}
  635.     ### OM_title            label of the program, used in the window's label
  636.     set OM_title "OmniMoni v[lindex [string trim $revision {$}] 1]"
  637.     ### OM_legal            basic legal information, used in help and intro window
  638.     set OM_legal1 "$OM_title, Copyright (C) 1995  Rainer Mager"
  639.     set OM_legal2 "OmniMoni comes with ABSOLUTELY NO WARRANTY; for details use ``--legal'' option."
  640.  
  641.     global Debug Indent Indent_Chars Update_Delta Elapsed_Seconds OmniConfigFile
  642.     ### Debug                debug level, check the Debug procedure for more info
  643.     set Debug 0
  644.     ### Indent                level of indention for debug level 2
  645.     set Indent 0
  646.     ### Indent_Chars        characters for indenting debug level 2
  647.     set Indent_Chars "    "
  648.     ### Update_Delta        number of seconds between checking for updates
  649.     set Update_Delta 1
  650.     ### Elapsed_Seconds        number of seconds the program has been running so far
  651.     set Elapsed_Seconds 0
  652.     ### OmniConfigFile        file name of the configuration file
  653.     set OmniConfigFile "~/.omnimoni"
  654.     ### LIB_PATH            path to the GIF files
  655.     set LIB_PATH "/usr/local/lib/omnimoni"
  656.  
  657.     global Iconify To_Unpack PACK_ORDER Graph_Sort
  658.     ### Iconify                boolean to iconfiy the main window at startup or not
  659.     set Iconify 0
  660.     ### To_Unpack            list of widgets to be unpacked after initial pass
  661.     set To_Unpack ""
  662.     ### PACK_ORDER            what order to pack things at creation
  663.     set PACK_ORDER 1
  664.     ### Graph_Sort            used to sort the lines in a plot
  665.     set Graph_Sort ""
  666.  
  667.     global Defaults
  668.     set Defaults(LABEL-PLACE) "top"
  669.     set Defaults(LABEL-EXTRA) ""
  670.     set Defaults(COMMAND) ""
  671.     set Defaults(PLACE) "top"
  672.     set Defaults(UPDATE) 10
  673.     set Defaults(EXTRA) ""
  674.     set Defaults(WIDTH) 320
  675.     set Defaults(HEIGHT) 200
  676.     set Defaults(HASHES) 0
  677.     set Defaults(ZEROCOL) "\#fff"
  678.     set Defaults(HASHCOL) "\#999"
  679.     set Defaults(HISTORY) 0
  680.     set Defaults(DIRECTION) "left"
  681.     set Defaults(COLOR) "\#fff"
  682.     set Defaults(TYPE) "lined"
  683. }
  684.  
  685. ### END DoGlobals
  686. #################
  687.  
  688.  
  689. #########################################
  690. ### Initialize everything and then begin.
  691.  
  692. proc InitAll {} {
  693.     global OM_title OmniConfigFile OM_legal1 OM_legal2 Update_Delta Indent Windows Iconify \
  694.             Toggle_Iconify To_Unpack LIB_PATH
  695.     # this is needed for some of those graphs
  696.     set tcl_precision 17
  697.     DoGlobals
  698.     GetENVs
  699.     # CLAs come second to override ENVs
  700.     GetCLAs
  701.     # make window how I like it
  702.     wm resizable . no no
  703.     wm title . $OM_title
  704.     wm iconname . OmniMoni
  705.     wm protocol . WM_DELETE_WINDOW exit
  706.     . config -bg \#116
  707.     # put a picture or a message in there
  708.     if {[file exists $LIB_PATH/omnimoni.big.gif]} {
  709.         canvas .intro
  710.         image create photo omnimoni-big -file $LIB_PATH/omnimoni.big.gif
  711.         .intro create image 0 0 -image omnimoni-big -anchor nw
  712.         .intro config -width [image width omnimoni-big] -height [image height omnimoni-big]
  713.     } else {
  714.         message .intro -justify center -aspect 450 \
  715.                 -font "-Adobe-Helvetica-Bold-R-Normal--*-120-*" \
  716.                 -text "$OM_legal1\n$OM_legal2\nPlease wait.  Setting up..."
  717.         .intro configure -bg \#116 -fore \#c34
  718.     }
  719.     pack .intro
  720.     # put up the intro message whine they wait
  721.     update
  722.     # make the top level stuff
  723.     MyCatch "menu .pack_ -tearoff 0" "Error: could not create main menu!"
  724.     DoBinds ""
  725.     # go parse the config file
  726.     ParseTop [LoadConfigFile $OmniConfigFile]
  727.     # create everything that was parsed
  728.     set Indent -1
  729.     foreach window [array names Windows] {
  730.         MyCatch "menu .pack_$window -tearoff 0" \
  731.                 "Error: could not create menu for WINDOW ``$window''!"
  732.         DoBinds $window
  733.         CreateWidgets $window
  734.         if {$Toggle_Iconify(.$window)} {
  735.             wm deiconify .$window
  736.         }
  737.     }
  738.     set Indent 0
  739.     # unpack everything that is set to be unpacked by default
  740.     foreach widget $To_Unpack {
  741.         Unpack .$widget
  742.     }
  743.     unset To_Unpack
  744.     # change the message to something more subtle
  745.     if {[image names] == "omnimoni-big"} {
  746.         image delete omnimoni-big
  747.     }
  748.     if {[file exists $LIB_PATH/omnimoni.small.gif]} {
  749.         image create photo omnimoni-small -file $LIB_PATH/omnimoni.small.gif
  750.         .intro create image 0 0 -image omnimoni-small -anchor nw
  751.         .intro config -width [image width omnimoni-small] -height [image height omnimoni-small]
  752.     } else {
  753.         .intro configure -aspect 5000 -text "$OM_legal1"
  754.     }
  755.     # get rid of the into window if we're supposed to
  756.     if {$Iconify} {
  757.         wm iconify .
  758.     }
  759.     unset Iconify
  760.     # start the time going
  761.     UpdateSeconds $Update_Delta
  762. }
  763.  
  764. ### END InitAll
  765. ###############
  766.  
  767.  
  768.  
  769. ################
  770. ################
  771. ### Creation ###
  772. ################
  773. ################
  774.  
  775. ###############################################################################
  776. ### Recursive procedure to check the top level and do initial pass stuff on it.
  777.  
  778. proc ParseTop { config_file } {
  779.     MyCatch "llength {$config_file}" \
  780.             "Error: syntax problem in the top level of the config file:"
  781.     for {set index_count 0} {$index_count < [llength $config_file]} {incr index_count 2} {
  782.         # go through each "command argument" pair
  783.         set key_word [lindex $config_file $index_count]
  784.         set arguments [lindex $config_file [expr $index_count + 1]]
  785.         switch -- $key_word {
  786.             "\#" -
  787.             COMMENT {
  788.                 # take the next section as comments
  789.                 Debug 1 "COMMENT\n"
  790.             }
  791.             !WINDOW -
  792.             WINDOW {            
  793.                 MyCatch "llength {$arguments}" "Error: syntax problem in WINDOW in \
  794.                         the top level:"
  795.                 if {[string index $key_word 0] == "!"} {
  796.                     ParseWindow $arguments 1
  797.                 } else {
  798.                     ParseWindow $arguments 0
  799.                 }
  800.             }
  801.             INCLUDE {
  802.                 MyCatch "llength {$arguments}" "Error: syntax problem in INCLUDE in \
  803.                         the top level:"
  804.                 set arguments [VarSub $arguments]
  805.                 set config_file [concat [lrange $config_file 0 [expr $index_count - 1]] \
  806.                         [LoadConfigFile $arguments] \
  807.                         [lrange $config_file [expr $index_count +2] end]]
  808.                 incr index_count -2
  809.             }
  810.             CONFIGURE {
  811.                 MyCatch "llength {$arguments}" "Error: syntax problem in CONFIGURE in \
  812.                         the top level:"
  813.                 ParseConfigure $arguments
  814.             }
  815.             default {
  816.                 # if this piece is a single piece
  817.                 Blurb "Warning: found a section beginning with ``$key_word'', ignoring section!" -9
  818.             }
  819.         }
  820.     }
  821. }
  822.  
  823. ### END ParseTop
  824. ################
  825.  
  826.  
  827. ##############################################
  828. ### Parse a WINDOW section of the config file.
  829.  
  830. proc ParseWindow { section DONT_PACK } {
  831.     global PACK_ORDER Windows OM_title Windows Toggle_Iconify Debug
  832.     # take the next bracketed section as a group command
  833.     MyCatch "llength {$section}" "Error: syntax problem in WINDOW section:"
  834.     if {[lindex $section 0] != "NAME"} {
  835.         # every window must have a name as the first command
  836.         Blurb "Error: the first item in a WINDOW must by the group's NAME! You had \
  837.                 ``[lindex $section 0]'' instead!" -7
  838.         exit 1
  839.     }
  840.     set real_window_name [lindex $section 1]
  841.     if {[string match {*[.{}]*} $real_window_name] == 1} {
  842.         # check for weird characters
  843.         Blurb "Error: the NAME of WINDOW, ``$real_window_name'', can not have any of the \
  844.                 characters ``\{'', ``\}'', or ``.''!" -7
  845.         exit 1
  846.     }
  847.     set lower_window_name [string tolower $real_window_name]
  848.     if {[winfo exists .$lower_window_name]} {
  849.         # check it it already exists
  850.         Blurb "Error: the WINDOW, ``$real_window_name'', already exists, can not create another one!" -7
  851.         exit 1
  852.     }
  853.     Debug 1 "Entered WINDOW       -> $real_window_name\n"
  854.     MyCatch "toplevel .$lower_window_name" "Error: could not create WINDOW ``$real_window_name''!"
  855.     # make this window the way I like it
  856.     wm resizable .$lower_window_name no no
  857.     wm title .$lower_window_name $OM_title
  858.     .pack_ add checkbutton -label "$real_window_name" -command "ToggleIconify \
  859.             .$lower_window_name" -variable Toggle_Iconify(.$lower_window_name)
  860.     if {$DONT_PACK} {
  861.         # if we're to unpack this window at start up
  862.         set Windows($lower_window_name) 0
  863.         set Toggle_Iconify(.$lower_window_name) 0    
  864.         ToggleIconify .$lower_window_name
  865.     } else {
  866.         set Windows($lower_window_name) $PACK_ORDER
  867.         set Toggle_Iconify(.$lower_window_name) 1
  868.     }
  869.     if {![Debug 64 ""]} {
  870.         # if we're not to show everything as it is created
  871.         wm iconify .$lower_window_name
  872.     }
  873.     for {set index_count 2} {$index_count < [llength $section]} {incr index_count 2} {
  874.         # go through each "command argument" pair
  875.         set key_word [lindex $section $index_count]
  876.         set arguments [lindex $section [expr $index_count + 1]]
  877.         switch -- $key_word {
  878.             "\#" -
  879.             COMMENT {
  880.                 # take the next bracketed section as comments
  881.                 Debug 1 "COMMENT\n"
  882.             }
  883.             CONFIGURE {
  884.                 MyCatch "llength {$arguments}" "Error: syntax problem in CONFIGURE in \
  885.                         WINDOW, ``$real_window_name'':"
  886.                 ParseConfigure $arguments
  887.             }
  888.             LABEL {
  889.                 MyCatch "llength {$arguments}" "Error: syntax problem in LABEL in \
  890.                         WINDOW, ``$real_window_name'':"
  891.                 set arguments [VarSub $arguments]
  892.                 wm title .$lower_window_name $arguments
  893.             }
  894.             PLACE {
  895.                 set arguments [VarSub $arguments]
  896.                 if {[string index [set x [lindex $arguments 0]] 0] != "-"} {
  897.                     set x "+$x"
  898.                 }
  899.                 if {[string index [set y [lindex $arguments 1]] 0] != "-"} {
  900.                     set y "+$y"
  901.                 }
  902.                 MyCatch "wm geometry .$lower_window_name $x$y" "Warning: could not set PLACE \
  903.                         for WINDOW, ``$real_window_name''."
  904.             }
  905.             !GROUP -
  906.             GROUP {
  907.                 MyCatch "llength {$arguments}" "Error: syntax problem in GROUP in \
  908.                         WINDOW, ``$real_window_name'':"
  909.                 if {[string index $key_word 0] == "!"} {
  910.                     ParseGroup $lower_window_name $arguments 1
  911.                 } else {
  912.                     ParseGroup $lower_window_name $arguments 0
  913.                 }
  914.             }
  915.             !GRAPH -
  916.             GRAPH {            
  917.                 MyCatch "llength {$arguments}" "Error: syntax problem in GRAPH in \
  918.                         WINDOW, ``$real_window_name'':"
  919.                 if {[string index $key_word 0] == "!"} {
  920.                     ParseGraph $lower_window_name $arguments 1
  921.                 } else {
  922.                     ParseGraph $lower_window_name $arguments 0
  923.                 }
  924.             }
  925.             default {
  926.                 # if this piece is a single piece
  927.                 Blurb "Warning: found a section beginning with ``$key_word'', ignoring section!" -9
  928.             }
  929.         }
  930.     }
  931.     Debug 1 "Left WINDOW          <- $real_window_name\n"
  932. }
  933.  
  934. ### END ParseWindow
  935. ###################
  936.  
  937.  
  938. ###############################################################
  939. ### Change any global configuration options in the config file.
  940.  
  941. proc ParseConfigure { opt_list } {
  942.     global OmniConfigFile Update_Delta Defaults Substitutes
  943.     MyCatch "llength {$opt_list}" "Error:  syntax problem in CONFIGURE section:"
  944.     for {set index_count 0} {$index_count < [llength $opt_list]} {incr index_count 2} {
  945.         set key_word [lindex $opt_list $index_count]
  946.         set arguments [lindex $opt_list [expr $index_count + 1]]
  947.         Debug 1 "Configured option    >---< $key_word\n"
  948.         switch $key_word {
  949.             ASSIGN {
  950.                 MyCatch "llength {$arguments}" "Error: syntax problem in ASSIGN in \
  951.                         CONFIGURE:"
  952.                 set arguments [VarSub $arguments]
  953.                 set var_name [lindex $arguments 0]
  954.                 set value [lindex $arguments 1]
  955.                 if {[regexp {[^A-Z]} $var_name]} {
  956.                     Blurb "Warning: variable names must only contain capital letter, ignoring \
  957.                             ``$var_name''." -9
  958.                 } else {
  959.                     if {![info exists Substitutes($var_name)]} {
  960.                         set Substitutes($var_name) $value
  961.                         Debug 32 "Variable ``$var_name'' set to ``$value''.\n"
  962.                     } else {
  963.                         Debug 32 "Variable ``$var_name'' not set to ``$value'' because it was \
  964.                                 previously defined.\n"
  965.                     }
  966.                 }
  967.             }
  968.             "\#" -
  969.             COMMENT {
  970.                 # take the next bracketed section as comments
  971.                 Debug 1 "COMMENT\n"
  972.             }
  973.             DEFAULT {
  974.                 MyCatch "llength {$arguments}" "Error: syntax problem in DEFAULT in \
  975.                         CONFIGURE:"
  976.                 set default [lindex $arguments 0]
  977.                 set value [VarSub [lindex $arguments 1]]
  978.                 switch $default {
  979.                     PLACE -
  980.                     LABEL-PLACE {
  981.                         if {$value != "left" && $value != "right" && \
  982.                                 $value != "top" && $value != "bottom"} {
  983.                             Blurb "Warning: $default when setting DEFAULT must be \
  984.                                     one of ``left'', ``right'', ``top'', or ``bottom'', not \
  985.                                     ``$value''!" -9
  986.                         } else {
  987.                             set Defaults($default) "$value"
  988.                             Debug 32 "Set DEFAULT, ``$default'' to ``$value''.\n"
  989.                         }
  990.                     }
  991.                     UPDATE -
  992.                     WIDTH -
  993.                     HEIGHT -
  994.                     HASHES -
  995.                     HISTORY {
  996.                         if {[catch "expr $value + 1"]} {
  997.                             Blurb "Warning: $default when setting DEFAULT must be a number, not \
  998.                                     ``$value''!" -9
  999.                         } else {
  1000.                             set Defaults($default) "$value"
  1001.                             Debug 32 "Set DEFAULT, ``$default'' to ``$value''.\n"
  1002.                         }
  1003.                     }
  1004.                     COLOR -
  1005.                     HASHCOL -
  1006.                     ZEROCOL {
  1007.                         if {[CheckColor $value]} {
  1008.                             Blurb "Warning: $default, ``$value'', when setting DEFAULT is \
  1009.                                     not a recognized color!" -9
  1010.                         } else {
  1011.                             set Defaults($default) "$value"
  1012.                             Debug 32 "Set DEFAULT, ``$default'' to ``$value''.\n"
  1013.                         }
  1014.                     }
  1015.                     TYPE {
  1016.                         if {$value != "lined" && $value != "solid"} {
  1017.                             Blurb "Warning: PLOT TYPE, ``$value'', must be ``lined'' or \
  1018.                                     ``solid'' when setting DEFAULT!" -9
  1019.                         } else {
  1020.                             set Defaults($default) "$value"
  1021.                             Debug 32 "Set DEFAULT, ``$default'' to ``$value''.\n"
  1022.                         }
  1023.                     }
  1024.                     DIRECTION {
  1025.                         if {$value != "left" && $value != "right" && \
  1026.                                 $value != "up" && $value != "down"} {
  1027.                             Blurb "Warning: DIRECTION when setting DEFAULT must be one of \
  1028.                                     ``left'', ``right'', ``up'', or ``down'', not ``$value''!" -9
  1029.                         } else {
  1030.                             set Defaults($default) "$value"
  1031.                             Debug 32 "Set DEFAULT, ``$default'' to ``$value''.\n"
  1032.                         }
  1033.                     }
  1034.                     DELTA {
  1035.                         if {[catch "expr $value + 1"]} {
  1036.                             Blurb "Warning: tried to set UPDATE to non-number, ignoring!" -9
  1037.                         } else {
  1038.                             global Update_Delta
  1039.                             set Update_Delta $value
  1040.                             if {!($Update_Delta > 0)} {
  1041.                                 set Update_Delta 1
  1042.                                 Blurb "Warning: UPDATE must be positive, setting to 1!" -9
  1043.                             }
  1044.                         }
  1045.                     }
  1046.                     EXTRA -
  1047.                     LABEL-EXTRA -
  1048.                     COMMAND -
  1049.                     TYPE {
  1050.                         set Defaults($default) "$value"
  1051.                         Debug 32 "Set DEFAULT, ``$default'' to ``$value''.\n"
  1052.                     }
  1053.                     default {
  1054.                         Blurb "Error: tried to set an unrecognized DEFAULT, ``$default''!" -7
  1055.                         exit 1
  1056.                     }
  1057.                 }
  1058.             }
  1059.             EXTRA {
  1060.                 MyCatch "llength {$arguments}" "Error: syntax problem in EXTRA in \
  1061.                         CONFIGURE:"
  1062.                 set arguments [VarSub $arguments]
  1063.                 MyCatch "option add [lindex $arguments 0] [lindex $arguments 1]" \
  1064.                     "Warning: could not set MISC option ``[lindex $arguments 0]'' to \
  1065.                     ``[lindex $arguments 1]''."
  1066.             }
  1067.             INCLUDE {
  1068.                 MyCatch "llength {$arguments}" "Error: syntax problem in INCLUDE in \
  1069.                         CONFIGURE:"
  1070.                 set arguments [VarSub $arguments]
  1071.                 set opt_list [concat [lrange $opt_list 0 [expr $index_count - 1]] \
  1072.                         [LoadConfigFile $arguments] \
  1073.                         [lrange $opt_list [expr $index_count +2] end]]
  1074.                 incr index_count -2
  1075.             }
  1076.             default {
  1077.                 Blurb "Error: tried to configure an unrecognized option, ``$key_word''!" -7
  1078.                 exit 1
  1079.             }
  1080.         }
  1081.     }
  1082. }
  1083.  
  1084. ### END ParseConfigure
  1085. ######################
  1086.  
  1087.  
  1088. #############################################
  1089. ### Parse a GROUP section of the config file.
  1090.  
  1091. proc ParseGroup { parent_name section DONT_PACK } {
  1092.     global Defaults PACK_ORDER To_Unpack Times Last_Time
  1093.     MyCatch "llength {$section}" "Error: syntax problem in GROUP section:"
  1094.     if {$parent_name == ""} {
  1095.         set parent_name "top_frames"
  1096.     }
  1097.     if {[lindex $section 0] != "NAME"} {
  1098.         Blurb "Error: the first item in a GROUP must by the group's NAME! \
  1099.                 You had ``[lindex $section 0]'' instead!" -7
  1100.         exit 1
  1101.     }
  1102.     set real_frame_name [lindex $section 1]
  1103.     if {[string match {*[.{}]*} $real_frame_name] == 1} {
  1104.         Blurb "Error: the NAME of GROUP, ``$real_frame_name'', can not have any of the \
  1105.                 characters ``\{'', ``\}'', or ``.''!" -7
  1106.         exit 1
  1107.     }
  1108.     set lower_frame_name [string tolower $real_frame_name]
  1109.     set frame_name $parent_name.$lower_frame_name
  1110.     if {[info exists Times($frame_name)]} {
  1111.         # if this group already exists
  1112.         Blurb "Error: the GROUP, ``$real_frame_name'', already exists, can not create \
  1113.                 another one!" -7
  1114.         exit 1
  1115.     }
  1116.     set Times($frame_name) 0
  1117.     set Last_Time($frame_name) 0
  1118.     # add the name of this frame into the ones for its parent
  1119.     global [set parent_name] [set frame_name]
  1120.     set [set frame_name](NAME) $real_frame_name
  1121.     if {$DONT_PACK} {
  1122.         lappend To_Unpack $frame_name
  1123.     }
  1124.     set [set parent_name]($lower_frame_name) $PACK_ORDER
  1125.     incr PACK_ORDER
  1126.     Debug 1 "Entered GROUP        -> $parent_name.$real_frame_name\n"
  1127.     set [set frame_name](TYPE) "GROUP"
  1128.     for {set index_count 2} {$index_count < [llength $section]} {incr index_count 2} {
  1129.         set key_word [lindex $section $index_count]
  1130.         set arguments [lindex $section [expr $index_count + 1]]
  1131.         switch $key_word {
  1132.             "\#" -
  1133.             COMMENT {
  1134.                 # take the next bracketed section as comments
  1135.                 Debug 1 "COMMENT\n"
  1136.             }
  1137.             CONFIGURE {
  1138.                 MyCatch "llength {$arguments}" "Error: syntax problem in CONFIGURE in \
  1139.                         GROUP, ``$real_frame_name'':"
  1140.                 ParseConfigure $arguments
  1141.             }
  1142.             LABEL -
  1143.             !LABEL {
  1144.                 MyCatch "llength {$arguments}" "Error: syntax problem in LABEL in \
  1145.                         GROUP, ``$real_frame_name'':"
  1146.                 if {[string index $key_word 0] == "!"} {
  1147.                     ParseLabel $frame_name $arguments 1
  1148.                 } else {
  1149.                     ParseLabel $frame_name $arguments 0
  1150.                 }
  1151.             }
  1152.             COMMAND {
  1153.                 set arguments [VarSub $arguments]
  1154.                 set [set frame_name](COMMAND) $arguments
  1155.             }
  1156.             UPDATE {
  1157.                 set arguments [VarSub $arguments]
  1158.                 if {[catch "expr $arguments + 1"]} {
  1159.                     Blurb "Warning: GROUP UPDATE, ``$arguments'', must be a number for \
  1160.                             ``$parent_name.$real_frame_name''!  Setting to DEFAULT, \
  1161.                             $Defaults(UPDATE)." -9
  1162.                 } else {
  1163.                     set [set frame_name](UPDATE) $arguments
  1164.                 }
  1165.             }
  1166.             PLACE {
  1167.                 set arguments [VarSub $arguments]
  1168.                 if {$arguments == "left" || $arguments == "right" || \
  1169.                         $arguments == "top" || $arguments == "bottom"} {
  1170.                     set [set frame_name](PLACE) $arguments
  1171.                 } else {
  1172.                     Blurb "Warning: PLACE for GROUP, ``$parent_name.$real_frame_name'' must be \
  1173.                             one of ``left'', ``right'', ``top'', or ``bottom'', not \
  1174.                             ``$arguments''! Setting to DEFAULT, ``$Defaults(PLACE)''." -9
  1175.                 }
  1176.             }
  1177.             EXTRA {
  1178.                 MyCatch "llength {$arguments}" "Error: syntax problem in EXTRA in \
  1179.                         GROUP, ``$real_frame_name'':"
  1180.                 set arguments [VarSub $arguments]
  1181.                 set [set frame_name](EXTRA) $arguments
  1182.             }
  1183.             GROUP -
  1184.             !GROUP {
  1185.                 MyCatch "llength {$arguments}" "Error: syntax problem in GROUP in \
  1186.                         GROUP, ``$real_frame_name'':"
  1187.                 if {[string index $key_word 0] == "!"} {
  1188.                     ParseGroup $frame_name $arguments 1
  1189.                 } else {
  1190.                     ParseGroup $frame_name $arguments 0
  1191.                 }
  1192.             }
  1193.             GRAPH -
  1194.             !GRAPH {
  1195.                 MyCatch "llength {$arguments}" "Error: syntax problem in GRAPH in \
  1196.                         GROUP, ``$real_frame_name'':"
  1197.                 if {[string index $key_word 0] == "!"} {
  1198.                     ParseGraph $frame_name $arguments 1
  1199.                 } else {
  1200.                     ParseGraph $frame_name $arguments 0
  1201.                 }
  1202.             }
  1203.             INCLUDE {
  1204.                 MyCatch "llength {$arguments}" "Error: syntax problem in INCLUDE in \
  1205.                         GROUP, ``$real_frame_name'':"
  1206.                 set arguments [VarSub $arguments]
  1207.                 set section [concat [lrange $section 0 [expr $index_count - 1]] \
  1208.                         [LoadConfigFile $arguments] \
  1209.                         [lrange $section [expr $index_count +2] end]]
  1210.                 incr index_count -2
  1211.             }
  1212.             default {
  1213.                 Blurb "Warning: found unrecognized word, ``$key_word'', in GROUP \
  1214.                         ``$parent_name.$real_frame_name''!" -9
  1215.             }
  1216.         }
  1217.     }
  1218.     foreach item "COMMAND UPDATE PLACE EXTRA" {
  1219.         if {![info exists [set frame_name]($item)]} {
  1220.             set [set frame_name]($item) $Defaults($item)
  1221.         }
  1222.     }
  1223.     Debug 1 "Left group           <- $parent_name.$real_frame_name\n"
  1224. }
  1225.  
  1226. ### END ParseGroup
  1227. ###################
  1228.  
  1229.  
  1230. #############################################
  1231. ### Parse a LABEL section of the config file.
  1232.  
  1233. proc ParseLabel { parent_name section DONT_PACK } {
  1234.     global Defaults PACK_ORDER To_Unpack Times Last_Time
  1235.     MyCatch "llength {$section}" "Error: syntax problem in LABEL section:"
  1236.     if {[lindex $section 0] != "NAME"} {
  1237.         Blurb "Error: the first item in a LABEL must by the label's NAME! \
  1238.                 You had ``[lindex $section 0]'' instead!" -7
  1239.         exit 1
  1240.     }
  1241.     set real_label_name [lindex $section 1]
  1242.     if {[string match {*[.{}]*} $real_label_name] == 1} {
  1243.         Blurb "Error: the NAME of LABEL, ``$real_label_name'', can not have any of the \
  1244.                 characters ``\{'', ``\}'', or ``.''!" -7
  1245.         exit 1
  1246.     }
  1247.     set lower_label_name [string tolower $real_label_name]
  1248.     set label_name $parent_name.$lower_label_name
  1249.     if {[info exists Times($label_name)]} {
  1250.         # if this label already exists
  1251.         Blurb "Error: the LABEL, ``$real_label_name'', already exists, can no create \
  1252.                 another one!" -7
  1253.         exit 1
  1254.     }
  1255.     set Times($label_name) 0
  1256.     set Last_Time($label_name) 0
  1257.     # add the name of this frame into the ones for its parent
  1258.     global [set parent_name] [set label_name]
  1259.     set [set label_name](NAME) $real_label_name
  1260.     if {$DONT_PACK} {
  1261.         lappend To_Unpack $label_name
  1262.     }
  1263.     set [set parent_name]($lower_label_name) $PACK_ORDER
  1264.     incr PACK_ORDER
  1265.     Debug 1 "Configured LABEL     -> $parent_name.$real_label_name\n"
  1266.     set [set label_name](TYPE) "LABEL"
  1267.     for {set index_count 2} {$index_count < [llength $section]} {incr index_count 2} {
  1268.         set key_word [lindex $section $index_count]
  1269.         set arguments [lindex $section [expr $index_count + 1]]
  1270.         switch $key_word {
  1271.             "\#" -
  1272.             COMMENT {
  1273.                 # take the next bracketed section as comments
  1274.                 Debug 1 "COMMENT\n"
  1275.             }
  1276.             STATIC {
  1277.                 MyCatch "llength {$arguments}" "Error: syntax problem in STATIC in \
  1278.                         LABEL, ``$real_label_name'':"
  1279.                 set arguments [VarSub $arguments]
  1280.                 if {[info exists FOUND_STRING]} {
  1281.                     Blurb "Error: can only have one string in LABEL, ``$parent_name'', \
  1282.                             you already have a $FOUND_STRING, \
  1283.                             ``[set [set label_name]($FOUND_STRING)]'' \
  1284.                             before the STATIC, ``$arguments''!" -7
  1285.                     exit 1
  1286.                 } else {
  1287.                     set [set label_name](STATIC) $arguments
  1288.                     set FOUND_STRING "STATIC"
  1289.                 }
  1290.             }
  1291.             EXPRESSION {
  1292.                 MyCatch "llength {$arguments}" "Error: syntax problem in EXPRESSION in \
  1293.                         LABEL, ``$real_label_name'':"
  1294.                 set arguments [VarSub $arguments]
  1295.                 if {[info exists FOUND_STRING]} {
  1296.                     Blurb "Error: can only have one string in LABEL, ``$parent_name'', \
  1297.                             you already have a $FOUND_STRING, \
  1298.                             ``[set [set label_name]($FOUND_STRING)]'' \
  1299.                             before the EXPRESSION, ``$arguments''!" -7
  1300.                     exit 1
  1301.                 } else {
  1302.                     set [set label_name](EXPRESSION) $arguments
  1303.                     set FOUND_STRING "EXPRESSION"
  1304.                 }
  1305.             }
  1306.             PLACE {
  1307.                 set arguments [VarSub $arguments]
  1308.                 if {$arguments == "left" || $arguments == "right" || \
  1309.                         $arguments == "top" || $arguments == "bottom"} {
  1310.                     set [set label_name](PLACE) $arguments
  1311.                 } else {
  1312.                     Blurb "Warning: PLACE for LABEL, ``$parent_name'' must be \
  1313.                             one of ``left'', ``right'', ``top'', or ``bottom'', not \
  1314.                             ``$arguments''! Setting to DEFAULT, ``$Defaults(LABEL-PLACE)''." -9
  1315.                     set [set label_name](PLACE) $Defaults(LABEL-PLACE)
  1316.                 }
  1317.             }
  1318.             EXTRA {
  1319.                 MyCatch "llength {$arguments}" "Error: syntax problem in EXTRA in \
  1320.                         LABEL, ``$real_label_name'':"
  1321.                 set arguments [VarSub $arguments]
  1322.                 set [set label_name](EXTRA) $arguments
  1323.             }
  1324.             default {
  1325.                 Blurb "Error: found unrecognized word, ``$key_word'', in LABEL \
  1326.                         ``$parent_name''!" -7
  1327.                 exit 1
  1328.             }
  1329.         }
  1330.     }
  1331.     set FOUND_STRING 0
  1332.     foreach item "STATIC EXPRESSION" {
  1333.         if {[info exists [set label_name]($item)]} {
  1334.             set FOUND_STRING 1
  1335.         }
  1336.     }
  1337.     if {!$FOUND_STRING} {
  1338.         Blurb "Error: you must specify one string in the LABEL, ``$real_label_name``, \
  1339.                 in the GROUP, ``$parent_name''!" -7
  1340.         exit 1
  1341.     }
  1342.     foreach item "PLACE EXTRA" {
  1343.         if {![info exists [set label_name]($item)]} {
  1344.             set [set label_name]($item) $Defaults(LABEL-$item)
  1345.         }
  1346.     }
  1347. }
  1348.  
  1349. ### END ParseLabel
  1350. ##################
  1351.         
  1352.  
  1353. ###########################################
  1354. ### Parse a GRAPH section of a config file.
  1355.  
  1356. proc ParseGraph { parent_name section DONT_PACK } {
  1357.     global Times Last_Time PACK_ORDER Defaults To_Unpack
  1358.     # take the next bracketed section as a group command
  1359.     MyCatch "llength {$section}" "Error: syntax problem in GRAPH section:"
  1360.     if {[lindex $section 0] != "NAME"} {
  1361.         Blurb "Error: the first item in a GRAPH must by the graph's NAME! \
  1362.                 You had ``[lindex $section 0]'' instead!" -7
  1363.         exit 1
  1364.     }
  1365.     set real_graph_name [lindex $section 1]
  1366.     if {[string match {*[.{}]*} $real_graph_name] == 1} {
  1367.         Blurb "Error: the NAME of GRAPH, ``$real_graph_name'', can not have any of the \
  1368.                 characters ``\{'', ``\}'', or ``.''!" -7
  1369.         exit 1
  1370.     }
  1371.     set lower_graph_name [string tolower $real_graph_name]
  1372.     set graph_name $parent_name.$lower_graph_name
  1373.     if {[info exists Times($graph_name)]} {
  1374.         # if this graph already exists
  1375.         Blurb "Error: the GRAPH, ``$real_graph_name'', already exists, can not create \
  1376.                 another one!" -7
  1377.         exit 1
  1378.     }
  1379.     set Times($graph_name) 0
  1380.     set Last_Time($graph_name) 0
  1381.     # add the name of this graph into the ones for its parent
  1382.     global [set parent_name]
  1383.     global [set graph_name]
  1384.     set [set graph_name](NAME) $real_graph_name
  1385.     if {$DONT_PACK} {
  1386.         lappend To_Unpack $graph_name
  1387.     }
  1388.     set [set parent_name]($lower_graph_name) $PACK_ORDER
  1389.     incr PACK_ORDER
  1390.     Debug 1 "Entered GRAPH        -> $parent_name.$real_graph_name\n"
  1391.     set [set graph_name](TYPE) "GRAPH"
  1392.     for {set index_count 2} {$index_count < [llength $section]} {incr index_count 2} {
  1393.         set key_word [lindex $section $index_count]
  1394.         set arguments [lindex $section [expr $index_count + 1]]
  1395.         switch $key_word {
  1396.             "\#" -
  1397.             COMMENT {
  1398.                 # take the next bracketed section as comments
  1399.                 Debug 1 "COMMENT\n"
  1400.             }
  1401.             CONFIGURE {
  1402.                 MyCatch "llength {$arguments}" "Error: syntax problem in CONFIGURE in \
  1403.                         GRAPH, ``$real_graph_name'':"
  1404.                 ParseConfigure $arguments
  1405.             }
  1406.             WIDTH {
  1407.                 MyCatch "llength {$arguments}" "Error: syntax problem in WIDTH in \
  1408.                         GRAPH, ``$real_graph_name'':"
  1409.                 set arguments [VarSub $arguments]
  1410.                 if {[catch "expr $arguments + 0"] || $arguments < 5} {
  1411.                     Blurb "Warning: the WIDTH of GRAPH ``$parent_name.$real_graph_name'' \
  1412.                             must be a number at least 5, not ``$arguments''! Setting WIDTH \
  1413.                             to 5." -9
  1414.                     set [set graph_name](WIDTH) 5
  1415.                 } else {
  1416.                     set [set graph_name](WIDTH) $arguments
  1417.                 }
  1418.             }
  1419.             HEIGHT {
  1420.                 MyCatch "llength {$arguments}" "Error: syntax problem in HEIGHT in \
  1421.                         GRAPH, ``$real_graph_name'':"
  1422.                 set arguments [VarSub $arguments]
  1423.                 if {[catch "expr $arguments + 0"] || $arguments < 5} {
  1424.                     Blurb "Warning: the HEIGHT of GRAPH ``$parent_name.$real_graph_name'' \
  1425.                             must be a number at least 5, not ``$arguments''! Setting HEIGHT \
  1426.                             to 5." -9
  1427.                     set [set graph_name](HEIGHT) 5
  1428.                 } else {
  1429.                     set [set graph_name](HEIGHT) $arguments
  1430.                 }
  1431.             }
  1432.             HASHES {
  1433.                 MyCatch "llength {$arguments}" "Error: syntax problem in HASHES in \
  1434.                         GRAPH, ``$real_graph_name'':"
  1435.                 set arguments [VarSub $arguments]
  1436.                 if {[catch "expr $arguments + 0"]} {
  1437.                     Blurb "Warning: the HASHES of GRAPH ``$parent_name.$real_graph_name'' \
  1438.                             must be a number, not ``$arguments''! Setting to the DEFAULT, \
  1439.                             ``$Defaults(HASHES)''." -9
  1440.                 } else {
  1441.                     set [set graph_name](HASHES) $arguments
  1442.                 }
  1443.             }
  1444.             ZEROCOL {
  1445.                 MyCatch "llength {$arguments}" "Error: syntax problem in ZEROCOL in \
  1446.                         GRAPH, ``$real_graph_name'':"
  1447.                 set arguments [VarSub $arguments]
  1448.                 if {![CheckColor $arguments]} {
  1449.                     set [set graph_name](ZEROCOL) $arguments
  1450.                 } else {
  1451.                     Blurb "Warning: ZEROCOLOR, ``$arguments'', for GRAPH \
  1452.                             ``$parent_name.$real_graph_name'' is not a recognized color! \
  1453.                             Setting to DEFAULT, ``$Defaults(ZEROCOL)''." -9
  1454.                 }
  1455.             }
  1456.             HASHCOL {
  1457.                 MyCatch "llength {$arguments}" "Error: syntax problem in HASHCOL in \
  1458.                         GRAPH, ``$real_graph_name'':"
  1459.                 set arguments [VarSub $arguments]
  1460.                 if {![CheckColor $arguments]} {
  1461.                     set [set graph_name](HASHCOL) $arguments
  1462.                 } else {
  1463.                     Blurb "Warning: HASHCOLOR, ``$arguments'', for GRAPH \
  1464.                             ``$parent_name.$real_graph_name'' is not a recognized color! \
  1465.                             Setting to DEFAULT, ``$Defaults(HASHCOL)''." -9
  1466.                 }
  1467.             }
  1468.             COMMAND {
  1469.                 set arguments [VarSub $arguments]
  1470.                 set [set graph_name](COMMAND) $arguments
  1471.             }
  1472.             UPDATE {
  1473.                 set arguments [VarSub $arguments]
  1474.                 if {[catch "expr $arguments + 1"]} {
  1475.                     Blurb "Warning: GRAPH UPDATE, ``$arguments'', must be a number for \
  1476.                             ``$parent_name.$real_graph_name''!  Setting to DEFAULT, \
  1477.                             $Defaults(UPDATE)." -9
  1478.                 } else {
  1479.                     set [set graph_name](UPDATE) $arguments
  1480.                 }
  1481.             }
  1482.             DIRECTION {
  1483.                 MyCatch "llength {$arguments}" "Error: syntax problem in DIRECTION in \
  1484.                         GRAPH, ``$real_graph_name'':"
  1485.                 set arguments [VarSub $arguments]
  1486.                 if {$arguments == "left" || $arguments == "right" || \
  1487.                         $arguments == "up" || $arguments == "down"} {
  1488.                     set [set graph_name](DIRECTION) $arguments
  1489.                 } else {
  1490.                     Blurb "Warning: DIRECTION for PLOT, ``$parent_name.$real_graph_name'' \
  1491.                             must be one of ``left'', ``right'', ``up'', or ``down'', not \
  1492.                             ``$arguments''!  Setting to the DEFAULT ``$Defaults(DIRECTION)''." -9
  1493.                     set [set graph_name](DIRECTION) $Defaults(DIRECTION)
  1494.                 }
  1495.             }
  1496.             HISTORY {
  1497.                 MyCatch "llength {$arguments}" "Error: syntax problem in HISTORY in \
  1498.                         GRAPH, ``$real_graph_name'':"
  1499.                 set arguments [VarSub $arguments]
  1500.                 if {[catch "expr $arguments + 1"]} {
  1501.                     Blurb "Warning: GRAPH HISTORY, ``$arguments'', must be a number for \
  1502.                             ``$parent_name.$real_graph_name''!  Setting to DEFAULT, \
  1503.                             $Defaults(HISTORY)." -9
  1504.                 } else {
  1505.                     set [set graph_name](HISTORY) $arguments
  1506.                 }
  1507.             }
  1508.             PLACE {
  1509.                 set arguments [VarSub $arguments]
  1510.                 if {$arguments == "left" || $arguments == "right" || \
  1511.                         $arguments == "top" || $arguments == "bottom"} {
  1512.                     set [set graph_name](PLACE) $arguments
  1513.                 } else {
  1514.                     Blurb "Warning: PLACE for GRAPH, ``$parent_name.$real_graph_name'' \
  1515.                             must be one of ``left'', ``right'', ``top'', or ``bottom'', not \
  1516.                             ``$arguments''! Setting to the DEFAULT, ``$Defaults(PLACE)''." -7
  1517.                 }
  1518.             }
  1519.             EXTRA {
  1520.                 MyCatch "llength {$arguments}" "Error: syntax problem in EXTRA in \
  1521.                         GRAPH, ``$real_graph_name'':"
  1522.                 set arguments [VarSub $arguments]
  1523.                 set [set graph_name](EXTRA) $arguments
  1524.             }
  1525.             PLOT -
  1526.             !PLOT {
  1527.                 MyCatch "llength {$arguments}" "Error: syntax problem in PLOT in \
  1528.                         GRAPH, ``$real_graph_name'':"
  1529.                 if {[string index $key_word 0] == "!"} {
  1530.                     ParsePlot $graph_name $arguments 1
  1531.                 } else {
  1532.                     ParsePlot $graph_name $arguments 0
  1533.                 }
  1534.             }
  1535.             INCLUDE {
  1536.                 MyCatch "llength {$arguments}" "Error: syntax problem in INCLUDE in \
  1537.                         GRAPH, ``$real_graph_name'':"
  1538.                 set arguments [VarSub $arguments]
  1539.                 set section [concat [lrange $section 0 [expr $index_count - 1]] \
  1540.                         [LoadConfigFile $arguments] \
  1541.                         [lrange $section [expr $index_count +2] end]]
  1542.                 incr index_count -2
  1543.             }
  1544.             default {
  1545.                 Blurb "Warning: found unrecognized word, ``$key_word'', in GROUP \
  1546.                         ``$parent_name.$real_graph_name''!" -9
  1547.             }
  1548.         }
  1549.     }
  1550.     foreach item "COMMAND UPDATE PLACE EXTRA DIRECTION WIDTH HEIGHT HASHES ZEROCOL \
  1551.             HASHCOL HISTORY" {
  1552.         if {![info exists [set graph_name]($item)]} {
  1553.             set [set graph_name]($item) $Defaults($item)
  1554.         }
  1555.     }
  1556.     if {[set [set graph_name](DIRECTION)] == "up" || \
  1557.             [set [set graph_name](DIRECTION)] == "down"} {
  1558.         if {[set [set graph_name](HISTORY)] < [set [set graph_name](HEIGHT)]} {
  1559.             Blurb "Warning: HISTORY must be greater that or equal to HEIGHT in GRAPH \
  1560.                     ``$parent_name.$real_graph_name''! Setting HISTORY to \
  1561.                     [set [set graph_name](HEIGHT)]." -9
  1562.             set [set graph_name](HISTORY) [set [set graph_name](HEIGHT)]
  1563.         }
  1564.     } else {
  1565.         if {[set [set graph_name](HISTORY)] < [set [set graph_name](WIDTH)]} {
  1566.             Blurb "Warning: HISTORY must be greater that or equal to WIDTH in GRAPH \
  1567.                     ``$parent_name.$real_graph_name''! Setting HISTORY to \
  1568.                     [set [set graph_name](WIDTH)]." -9
  1569.             set [set graph_name](HISTORY) [set [set graph_name](WIDTH)]
  1570.         }
  1571.     }    
  1572.     Debug 1 "Left graph           <- $parent_name.$real_graph_name\n"
  1573. }
  1574.  
  1575. ### END ParseGraph
  1576. ##################
  1577.  
  1578.  
  1579. ############################################
  1580. ### Parse a PLOT section of the config file.
  1581.  
  1582. proc ParsePlot { parent_name section DONT_PACK } {
  1583.     global [set parent_name] Times Last_Time Defaults
  1584.     MyCatch "llength {$section}" "Error: syntax problem in PLOT section:"
  1585.     if {[lindex $section 0] != "NAME"} {
  1586.         Blurb "Error: the first item in a PLOT must by the PLOT's NAME! \
  1587.                 You had ``[lindex $section 0]'' instead!" -7
  1588.         exit 1
  1589.     }
  1590.     set real_plot_name [lindex $section 1]
  1591.     if {[string match {*[.{}]*} $real_plot_name] == 1} {
  1592.         Blurb "Error: the NAME of PLOT, ``$real_plot_name'', can not have any of the \
  1593.                 characters ``\{'', ``\}'', or ``.''!" -7
  1594.         exit 1
  1595.     }
  1596.     set lower_plot_name [string tolower $real_plot_name]
  1597.     set plot_name $parent_name.[string tolower $real_plot_name]
  1598.     global [set parent_name]
  1599.     global [set plot_name]
  1600.     if {[info exists [set plot_name](NAME)]} {
  1601.         # if this plot already exists
  1602.         Blurb "Error: the PLOT, ``$real_plot_name'', already exists, can not create \
  1603.                 another one!" -7
  1604.         exit 1
  1605.     }
  1606.     set Times($plot_name) 1
  1607.     set Last_Time($plot_name) 0
  1608.     # add the name of this plot into the ones for its parent
  1609.     set [set plot_name](NAME) $real_plot_name
  1610.     if {$DONT_PACK} {
  1611.         set [set parent_name]($lower_plot_name) 0
  1612.     } else {
  1613.         set [set parent_name]($lower_plot_name) 1
  1614.     }
  1615.     for {set index_count 2} {$index_count < [llength $section]} {incr index_count 2} {
  1616.         set key_word [lindex $section $index_count]
  1617.         set arguments [lindex $section [expr $index_count + 1]]
  1618.         switch $key_word {
  1619.             "\#" -
  1620.             COMMENT {
  1621.                 # take the next bracketed section as comments
  1622.                 Debug 1 "COMMENT\n"
  1623.             }
  1624.             EXPRESSION {
  1625.                 MyCatch "llength {$arguments}" "Error: syntax problem in CONFIGURE in \
  1626.                         PLOT, ``$real_plot_name'':"
  1627.                 set arguments [VarSub $arguments]
  1628.                 if {[info exists [set plot_name](EXPRESSION)]} {
  1629.                     Blurb "Error: can only have one EXPRESSION in PLOT, \
  1630.                             ``$parent_name.$real_plot_name'', you already have one, \
  1631.                             ``[set [set plot_name]($FOUND_VALUE)]''!" -7
  1632.                     exit 1
  1633.                 } else {
  1634.                     set [set plot_name](EXPRESSION) $arguments
  1635.                 }
  1636.             }
  1637.             COLOR {
  1638.                 MyCatch "llength {$arguments}" "Error: syntax problem in COLOR in \
  1639.                         PLOT, ``$real_plot_name'':"
  1640.                 set arguments [VarSub $arguments]
  1641.                 if {![CheckColor \{$arguments\}]} {
  1642.                     set [set plot_name](COLOR) $arguments
  1643.                 } else {
  1644.                     Blurb "Warning: COLOR, ``$arguments'', for PLOT \
  1645.                             ``$parent_name.$real_plot_name'' is not a recognized color! \
  1646.                             Setting to DEFAULT, ``$Defaults(COLOR)''." -9
  1647.                 }
  1648.             }
  1649.             TYPE {
  1650.                 MyCatch "llength {$arguments}" "Error: syntax problem in TYPE in \
  1651.                         PLOT, ``$real_plot_name'':"
  1652.                 set arguments [VarSub $arguments]
  1653.                 if {$arguments != "lined" && $arguments != "solid"} {
  1654.                     Blurb "Warning: PLOT TYPE, ``$arguments'', must be ``lined'' or ``solid'' \
  1655.                             in PLOT ``$parent_name.$real_plot_name''! Setting to DEFAULT, \
  1656.                             ``$Defaults(TYPE)''" -9
  1657.                 } else {
  1658.                     set [set plot_name](TYPE) $arguments
  1659.                 }
  1660.             }
  1661.             default {
  1662.                 Blurb "Warning: found unrecognized word, ``$key_word'', in PLOT \
  1663.                         ``$parent_name.$real_plot_name''!" -9
  1664.             }
  1665.         }
  1666.     }
  1667.     foreach item "COLOR TYPE" {
  1668.         if {![info exists [set plot_name]($item)]} {
  1669.             set [set plot_name]($item) $Defaults($item)
  1670.         }
  1671.     }
  1672. }
  1673.  
  1674. ### END ParsePlot
  1675. #################
  1676.  
  1677.  
  1678. #####################################################
  1679. ### Recursively create all widgets in a given WINDOW.
  1680.  
  1681. proc CreateWidgets { variable } {
  1682.     global sort_variable [set variable] Indent Debug Toggle_Pack Graph_Maxes Graph_Mins \
  1683.             Graph_Scale To_Unpack
  1684.     incr Indent
  1685.     set widget_list ""
  1686.     set sort_variable $variable
  1687.     foreach item [lsort [array names [set variable]]] {
  1688.         if {[set [set variable]($item)] != ""} {
  1689.             # if this item has a value
  1690.             if {[string tolower $item] == $item} {
  1691.                 # if it is a GROUP or GRAPH or PLOT
  1692.                 lappend widget_list $item
  1693.             } else {
  1694.                 Debug 2 "$variable.$item = [set [set variable]($item)]"
  1695.             }
  1696.         }
  1697.     }
  1698.     foreach item [lsort -command SortPackArray $widget_list] {
  1699.         Debug 2 "$variable.\b\b->$item = [set [set variable]($item)]"
  1700.         # go through the widgets in order of the config file
  1701.         global [set variable].[set item]
  1702.         if {[lsearch -exact $To_Unpack $variable.$item] != -1} {
  1703.             # if this one is to be unpacked
  1704.             # set it's value to 0 so we know it is (will be) unpacked
  1705.             set [set variable]($item) 0
  1706.         }
  1707.         if {[set [set variable].[set item](TYPE)] == "GROUP"} {
  1708.             set frame_name $variable.$item
  1709.             set menu_name .pack_$variable.$item
  1710.             set frame_label [set [set frame_name](NAME)]
  1711.             MyCatch "frame .$frame_name" "Error: could not create GROUP frame, \
  1712.                     ``$frame_name''!"
  1713.             pack .$frame_name -fill both -expand yes -side [set [set frame_name](PLACE)]
  1714.             foreach extra [set [set frame_name](EXTRA)] {
  1715.                 MyCatch ".$frame_name configure \{[lindex $extra 0]\} \{[lindex $extra 1]\}" \
  1716.                         "Warning: could not configure EXTRA option ``[lindex $extra 0]'' as \
  1717.                         ``[lindex $extra 1]'' for GROUP ``$variable.$frame_label''."
  1718.             }
  1719.             # mouse B1 demands update on label
  1720.             bind .$frame_name <Button-2> "Unpack .$frame_name"
  1721.             .pack_$variable add cascade -label $frame_label -menu $menu_name
  1722.             MyCatch "menu $menu_name -tearoff 0" \
  1723.                     "Error: could not create menu for ``$frame_name''!"
  1724.             $menu_name add checkbutton -label GROUP -variable Toggle_Pack(.$frame_name) \
  1725.                     -command "TogglePack .$frame_name"
  1726.             set Toggle_Pack(.$frame_name) 1
  1727.             set label_name ".[set frame_name].label"
  1728.         } elseif {[set [set variable].[set item](TYPE)] == "LABEL"} {
  1729.             set label_name $variable.$item
  1730.             set menu_name .pack_$variable
  1731.             CreateLabel $label_name
  1732.             foreach extra [set [set label_name](EXTRA)] {
  1733.                 MyCatch ".$label_name configure \{[lindex $extra 0]\} \{[lindex $extra 1]\}" \
  1734.                         "Warning: could not configure EXTRA option ``[lindex $extra 0]'' as \
  1735.                         ``[lindex $extra 1]'' for LABEL ``$label_name''."
  1736.             }
  1737.             $menu_name add checkbutton -label [set [set label_name](NAME)] -variable \
  1738.                     Toggle_Pack(.$label_name) -command "TogglePack .$label_name"
  1739.             set Toggle_Pack(.$label_name) 1            
  1740.         } elseif {[set [set variable].[set item](TYPE)] == "GRAPH"} {
  1741.             global Graph_Scale Graph_Maxes Graph_Mins
  1742.             set Graph_Maxes($variable.$item) 0.0
  1743.             set Graph_Mins($variable.$item) 0.0
  1744.             set Graph_Scale($variable.$item) "1.0 1.0"
  1745.             set graph_name $variable.$item
  1746.             set parent_menu .pack_$variable
  1747.             set menu_name .pack_$graph_name
  1748.             set graph_label [set [set graph_name](NAME)]
  1749.             set direction [set [set graph_name](DIRECTION)]
  1750.             set width [set [set graph_name](WIDTH)]
  1751.             set height [set [set graph_name](HEIGHT)]
  1752.             set history [set [set graph_name](HISTORY)]
  1753.             set extra [set [set graph_name](EXTRA)]
  1754.             set place [set [set graph_name](PLACE)]
  1755.             MyCatch "canvas .$graph_name -width $width -height $height -xscrollincrement 1 \
  1756.                     -yscrollincrement 1 -highlightthickness 0" \
  1757.                     "Error: could not create GRAPH, ``$graph_name''!"
  1758.             pack .$graph_name -side $place
  1759.             # mouse B1 demands update on label
  1760.             bind .$graph_name <Button-2> "Unpack .$graph_name"
  1761.             $parent_menu add cascade -label $graph_label -menu $menu_name
  1762.             MyCatch "menu $menu_name -tearoff 0" \
  1763.                     "Error: could not create menu for ``$graph_name''!"
  1764.             $menu_name add checkbutton -label GRAPH -variable Toggle_Pack(.$graph_name) \
  1765.                     -command "TogglePack .$graph_name"
  1766.             set Toggle_Pack(.$graph_name) 1
  1767.             bind .$graph_name <Button-1> "[list ScrollCanvas .$graph_name mark \
  1768.                     $direction $width $height $history %x %y]"
  1769.             bind .$graph_name <B1-Motion> "[list ScrollCanvas .$graph_name dragto \
  1770.                     $direction $width $height $history %x %y]"
  1771.             if {$direction == "left" || $direction == "right"} {
  1772.                 bind .$graph_name <Double-1> "[list .$graph_name xview moveto 0]"
  1773.             } else {
  1774.                 bind .$graph_name <Double-1> "[list .$graph_name yview moveto 0]"
  1775.             }
  1776.             bind .$graph_name <Button-2> "Unpack .$graph_name"
  1777.             set Graph_Maxes($graph_name) 0
  1778.             set Graph_Mins($graph_name) 0
  1779.             set Graph_Scale($graph_name) "1.0 1.0"
  1780.             foreach arg $extra {
  1781.                 MyCatch ".$graph_name configure \{[lindex $arg 0]\} \{[lindex $arg 1]\}" \
  1782.                         "Warning: could not configure EXTRA option ``[lindex $arg 0]'' \
  1783.                         as ``[lindex $arg 1]'' for GRAPH ``$graph_name''."
  1784.             }
  1785.             # this is necessary to put 0,0 is the upper left of the canvas
  1786.             set bw [lindex [.$graph_name config -borderwidth] 4]
  1787.             .$graph_name xview scroll -$bw units
  1788.             .$graph_name yview scroll -$bw units
  1789.         } elseif {[set [set variable].[set item](TYPE)] == "solid" || \
  1790.                 [set [set variable].[set item](TYPE)] == "lined"} {
  1791.             set plot_name $variable.$item
  1792.             set menu_name .pack_$variable.$item
  1793.             set plot_label [set [set plot_name](NAME)]
  1794.             .pack_$variable add checkbutton -label $plot_label -variable \
  1795.                     [set variable]($item) -command "TogglePlot [list $variable $item]"
  1796.         } else {
  1797.             Blurb "This message should never be seen (1)!" 0
  1798.         }
  1799.         if {[Debug 64 ""]} {
  1800.             update idletasks
  1801.         }
  1802.         CreateWidgets $variable.$item
  1803.     }
  1804.     incr Indent -1
  1805. }
  1806.  
  1807. ### END CreateWidgets
  1808. #####################
  1809.  
  1810.  
  1811. ##################################
  1812. ### Create a text label (message).
  1813.  
  1814. proc CreateLabel { label_name } {
  1815.     global Last_Output [set label_name]
  1816.      set label_widget ".$label_name"
  1817.      set label_side [set [set label_name](PLACE)]
  1818.      set label_args [set [set label_name](EXTRA)]
  1819.     MyCatch "message $label_widget -justify center -aspect 5000" \
  1820.             "Error: could not create LABEL ``$label_name''!"
  1821.     # mouse b2 unpack this label
  1822.     bind $label_widget <Button-2> "Unpack .$label_name"
  1823.     if {[info exists [set label_name](EXPRESSION)]} {
  1824.         # if label is a dynamic EXPRESSION
  1825.         if {[string match {*=*} [set [set label_name](EXPRESSION)]]} {
  1826.             # if there's an = sign in it
  1827.             # add it to the Last_Val array
  1828.             set Last_Output($label_name) {}
  1829.         }
  1830.         Debug 1 "Packed EXPRESSION    >---< $label_name\n"
  1831.         # mouse B1 demands update on label
  1832.         bind $label_widget <Button-1> "DemandUpdate $label_name"
  1833.      } else {
  1834.         MyCatch "$label_widget configure -text \{[set [set label_name](STATIC)]\}" \
  1835.                 "Error: could not label LABEL ``$label_name'' as \
  1836.                 ``[set [set label_name](STATIC)]''!"
  1837.         Debug 1 "Packed STATIC label  >---< $label_name\n"
  1838.     }
  1839.     
  1840.     foreach arg $label_args {
  1841.         MyCatch "$label_widget configure \{[lindex $arg 0]\} \{[lindex $arg 1]\}" \
  1842.                 "Warning: could not configure EXTRA option ``[lindex $arg 0]'' as \
  1843.                 ``[lindex $arg 1]'' for LABEL ``$label_name''."
  1844.     }
  1845.     MyCatch "pack $label_widget -fill both -expand yes -side $label_side" \
  1846.             "Error: could not pack LABEL ``$label_name'' at the ``$label_side''!"
  1847. }
  1848.  
  1849. ### END CreateLabel
  1850. ###################
  1851.  
  1852.  
  1853.  
  1854. ########################################
  1855. ### Put some bindings on a given window.
  1856.  
  1857. proc DoBinds { window } {
  1858.     global Toggle_Iconify
  1859.     bind .$window <Button-3> ".pack_$window post %X %Y"
  1860.     bind Menu <Button-1> "tkMenuEscape %W"
  1861.     bind Menu <Button-2> "tkMenuEscape %W"
  1862.     bind .$window <Q> "exit"
  1863.     bind .$window <Z> "wm iconify .$window; set Toggle_Iconify(.$window) 0"
  1864.     bind .$window <plus> {
  1865.         set Update_Delta [expr $Update_Delta + 1]
  1866.         Blurb "Update delta set to $Update_Delta." 0
  1867.         after [expr int($Update_Delta * 1000)] "UpdateSeconds $Update_Delta"
  1868.     }
  1869.     bind .$window <Control-plus> {
  1870.         set Update_Delta [expr $Update_Delta + 60]
  1871.         Blurb "Update delta set to $Update_Delta." 0
  1872.         after [expr int($Update_Delta * 1000)] "UpdateSeconds $Update_Delta"
  1873.     }
  1874.     bind .$window <minus> {
  1875.         set Update_Delta [expr $Update_Delta - 1]
  1876.         if {!($Update_Delta > 0)} {
  1877.             set Update_Delta 1
  1878.         }
  1879.         Blurb "Update delta set to $Update_Delta." 0
  1880.         after [expr int($Update_Delta * 1000)] "UpdateSeconds $Update_Delta"
  1881.     }
  1882.     bind .$window <Control-minus> {
  1883.         set Update_Delta [expr $Update_Delta - 60]
  1884.         if {!($Update_Delta > 0)} {
  1885.             set Update_Delta 1
  1886.         }
  1887.         Blurb "Update delta set to $Update_Delta." 0
  1888.         after [expr int($Update_Delta * 1000)] "UpdateSeconds $Update_Delta"
  1889.     }
  1890.     bind .$window <Control-KeyPress-1> "SetDebug %K"
  1891.     bind .$window <Control-KeyPress-2> "SetDebug %K"
  1892.     bind .$window <Control-KeyPress-3> "SetDebug %K"
  1893.     bind .$window <Control-KeyPress-4> "SetDebug %K"
  1894.     bind .$window <Control-KeyPress-5> "SetDebug %K"
  1895.     bind .$window <Control-KeyPress-6> "SetDebug %K"
  1896.     bind .$window <Control-KeyPress-7> "SetDebug %K"
  1897.     bind .$window <Control-KeyPress-8> "SetDebug %K"
  1898. }
  1899.  
  1900. ### END DoBinds
  1901. ###############
  1902.  
  1903.  
  1904.  
  1905. #########################
  1906. #########################
  1907. ### User Event Driven ###
  1908. #########################
  1909. #########################
  1910.  
  1911. #################################################################
  1912. ### Cause widget (and all ancestors) to do an update immediately.
  1913.  
  1914. proc DemandUpdate { frame_name } {
  1915.     global Times
  1916.     Debug 128 "\nDemanding Update >---< $frame_name\n"
  1917.     while { $frame_name != {} } {
  1918.         # strip from last . on
  1919.         set old_frame_name $frame_name
  1920.         set Times($frame_name) 0
  1921.         set frame_name [string range $frame_name 0 [expr \
  1922.                 [string last . $frame_name] - 1]]
  1923.     }
  1924.     UpdateWidgets $old_frame_name ""
  1925. }
  1926.  
  1927. ### END DemandUpdate
  1928. ####################
  1929.  
  1930.  
  1931. ################################################
  1932. ### Toggle unpacked or packed state of a widget.
  1933.  
  1934. proc TogglePack { widget_name } {
  1935.     global Toggle_Pack
  1936.     if {$Toggle_Pack($widget_name)} {
  1937.         # if has been Unpacked
  1938.         Repack $widget_name
  1939.     } else {
  1940.         Unpack $widget_name
  1941.     }
  1942. }
  1943.  
  1944. ### END TogglePack
  1945. ##################
  1946.  
  1947.  
  1948. #####################################
  1949. ### Toggle a WINDOW iconified or not.
  1950.  
  1951. proc ToggleIconify { window_name } {
  1952.     global Toggle_Iconify
  1953.     if {!$Toggle_Iconify($window_name)} {
  1954.         Debug 8 "Iconified WINDOW $window_name\n"
  1955.         wm iconify $window_name
  1956.     } else {
  1957.         Debug 8 "Deiconified WINDOW $window_name\n"
  1958.         wm deiconify $window_name
  1959.     }
  1960. }
  1961.  
  1962. ### END ToggleIconify
  1963. #####################
  1964.  
  1965.  
  1966. #####################################################
  1967. ### Toggle showing or not showing, a line in a graph.
  1968.  
  1969. proc TogglePlot { frame_name id } {
  1970.     global [set frame_name] [set frame_name].[set id]
  1971.     if {![set [set frame_name]($id)]} {
  1972.         # if was unmarked
  1973.         Debug 8 "Unpacked PLOT $id\n"
  1974.         # change the color to clear
  1975.         .$frame_name itemconfigure $id -fill ""
  1976.     } else {
  1977.         Debug 8 "Repacked PLOT $id\n"
  1978.         .$frame_name itemconfigure $id -fill [set [set frame_name].[set id](COLOR)]
  1979.     }
  1980. }
  1981.  
  1982. ### END TogglePlot
  1983. ##################
  1984.  
  1985.  
  1986. ###############################################################################
  1987. ### Unpack a widget and remember who it was packed after before being unpacked.
  1988.  
  1989. proc Unpack { widget_name } {
  1990.     global Unpacked Toggle_Pack OM_legal1 OM_legal2
  1991.     # stop the bindings while I do this
  1992.     bind $widget_name <Button-2> {}
  1993.     set Toggle_Pack($widget_name) 0
  1994.     set pack_info [pack info $widget_name]
  1995.     set ancestor [string range $widget_name 0 [expr [string first . \
  1996.             [string trimleft $widget_name .]]]]
  1997.     # find its parent
  1998.     set parent [string range $widget_name 0 [expr [string last . $widget_name] - 1]]
  1999.     # find its position in the pack list
  2000.     set list_index [lsearch -exact [pack slaves $parent] $widget_name]
  2001.     if {$list_index == 0} {
  2002.         # if it was the first widget
  2003.         # it was packed after nothing
  2004.         set packed_after first$parent
  2005.     } else {
  2006.         # find what it was packed after
  2007.         set packed_after [lindex [pack slaves $parent] [expr $list_index - 1]]
  2008.     }
  2009.     foreach var [array names Unpacked] {
  2010.         if {[lindex $Unpacked($var) 0] == $packed_after} {
  2011.             # was it unpacked after $packed_after
  2012.             # then we should be unpacked after it
  2013.             set packed_after $var
  2014.             break
  2015.         }
  2016.     }
  2017.     # remember the side and who after
  2018.     set Unpacked($widget_name) "$packed_after $pack_info"
  2019.     pack forget $widget_name
  2020.  
  2021.     set parent_array [string trimleft $parent .]
  2022.     global [set parent_array]
  2023.     if {[string first "label" $widget_name] == -1 && \
  2024.         [string first "graph" $widget_name] == -1} {
  2025.         set [set parent_array]([string trimleft [file extension $widget_name] .]) 0
  2026.     }
  2027.     Debug 8 "Unpacked $widget_name\n"
  2028.     bind $widget_name <Button-2> "Unpack $widget_name"
  2029.     if {[pack slaves $ancestor] == ""} {
  2030.         message $ancestor.intro -justify center -aspect 5000 -font \
  2031.                 "-Adobe-Helvetica-Bold-R-Normal--*-120-*" -text "$OM_legal1"
  2032.         $ancestor.intro configure -bg \#116 -fore \#c34
  2033.         pack $ancestor.intro -fill both -expand yes
  2034.     }
  2035. }
  2036.  
  2037. ### END Unpack
  2038. ##############
  2039.  
  2040.  
  2041. ###############################################################
  2042. ### Repack and unpacked widget back to where it was originally.
  2043.  
  2044. proc Repack { widget_name } {
  2045.     global Unpacked
  2046.     set pack_after [lindex $Unpacked($widget_name) 0]
  2047.     set pack_info [lrange $Unpacked($widget_name) 1 end]
  2048.     while {[info exists Unpacked($pack_after)]} {
  2049.         # check if after has been unpacked
  2050.         # then point to after's after
  2051.         set pack_after [lindex $Unpacked($pack_after) 0]
  2052.     }
  2053.     set ancestor [string range $widget_name 0 [expr [string first . \
  2054.             [string trimleft $widget_name .]]]]
  2055.     set parent [string range $widget_name 0 [expr [string last . $widget_name] - 1]]
  2056.     if {[pack slaves $ancestor] == "$ancestor.intro"} {
  2057.         pack forget $ancestor.intro
  2058.         destroy $ancestor.intro
  2059.     }
  2060.     if {$pack_after == "first$parent"} {
  2061.         # if it needs to be packed first
  2062.         # find first in pack list
  2063.         set pack_before [lindex [pack slaves $parent] 0]
  2064.         if {$pack_before == {}} {
  2065.             eval "pack $widget_name -expand yes $pack_info"
  2066.         } else {
  2067.             eval "pack $widget_name $pack_info -before $pack_before"
  2068.         }
  2069.     } else {
  2070.         eval "pack $widget_name $pack_info -after $pack_after"
  2071.     }
  2072.  
  2073.     set parent_array [string trimleft $parent .]
  2074.     global [set parent_array]
  2075.     if {[string first "label" $widget_name] == -1 && \
  2076.         [string first "graph" $widget_name] == -1} {
  2077.         set [set parent_array]([string trimleft [file extension $widget_name] .]) 1
  2078.     }
  2079.  
  2080.     unset Unpacked($widget_name)
  2081.     Debug 8 "Repacked $widget_name\n"
  2082. }
  2083.  
  2084. ### END Repack
  2085. ##############
  2086.  
  2087.  
  2088.  
  2089. #########################
  2090. #########################
  2091. ### Time Event Driven ###
  2092. #########################
  2093. #########################
  2094.  
  2095. ####################################################################
  2096. ### Update everything and then wait the update time and do it again.
  2097.  
  2098. proc UpdateSeconds { old_update_delta } {
  2099.     global Elapsed_Seconds Update_Delta  Windows
  2100.     if {$old_update_delta == $Update_Delta} {
  2101.         set Elapsed_Seconds [expr $Elapsed_Seconds + $Update_Delta]
  2102.         Debug 128 "\nIncreased Time   >---< $Elapsed_Seconds Seconds\n"
  2103.         foreach window [array names Windows] {
  2104.             UpdateWidgets $window ""
  2105.         }
  2106.         after [expr int($Update_Delta * 1000)] "UpdateSeconds $Update_Delta"
  2107.     }
  2108. }
  2109.  
  2110. ### END undateSeconds
  2111. #####################
  2112.  
  2113.  
  2114. #####################################################
  2115. ### Recursively update all widgets in a given WINDOW.
  2116.  
  2117. proc UpdateWidgets { variable output } {
  2118.     global sort_variable [set variable] Indent Debug Toggle_Pack Times Elapsed_Seconds
  2119.     set sort_variable $variable
  2120.     set frame_list ""
  2121.     foreach item [array names $variable] {
  2122.         if {[set [set variable]($item)] != 0} {
  2123.             # if this item has a value (not unpacked)
  2124.             if {[string tolower $item] == $item} {
  2125.                 # if it is a GROUP or GRAPH or LABEL or PLOT
  2126.                 lappend frame_list $item
  2127.             }
  2128.         } else {
  2129.             Debug 128 "Skipping item    >---< $variable.$item\n"
  2130.         }
  2131.     }
  2132.     foreach item $frame_list {
  2133.         # go through the frames
  2134.         global [set variable].[set item]
  2135.         # pass on $output if not regenerated
  2136.         set command_out $output
  2137.         if {$Times($variable.$item) <= $Elapsed_Seconds} {
  2138.             set frame_name $variable.$item
  2139.             set label_name ".[set frame_name].label"
  2140.             if {[set [set variable].[set item](TYPE)] == "GROUP"} {
  2141.                 Debug 128 "Updating GROUP   -> $frame_name\n"
  2142.                 if {[info exists [set frame_name](COMMAND)] && \
  2143.                         [set [set frame_name](COMMAND)] != "" && \
  2144.                         ![Debug 4 ""]} {
  2145.                     # if there is a COMMAND for this group
  2146.                     foreach command \{[set [set frame_name](COMMAND)]\} {
  2147.                         append command_out [MyCatch "exec sh -c [list $command]" \
  2148.                                 "Warning: could not execute COMMAND ``$command'' in \
  2149.                                 ``$frame_name''."]
  2150.                     }
  2151.                 }
  2152.                 UpdateWidgets $frame_name $command_out
  2153.                 Debug 128 "Finished GROUP   <- $frame_name\n"
  2154.                 set Times($frame_name) [expr $Elapsed_Seconds + [set [set frame_name](UPDATE)]]
  2155.             } elseif {[set [set variable].[set item](TYPE)] == "LABEL"} {
  2156.                 set label_name $variable.$item
  2157.                 if {[info exists [set label_name](EXPRESSION)]} {
  2158.                     MyCatch ".$label_name configure -text \{[EvalSpecial \
  2159.                             [set [set label_name](EXPRESSION)] $command_out \
  2160.                             $label_name]\}" \
  2161.                             "Warning: could not update EXPRESSION for ``$label_name''."
  2162.                     Debug 128 "Updated LABEL    >---< $label_name\n"
  2163.                 }
  2164.             } elseif {[set [set variable].[set item](TYPE)] == "GRAPH"} {
  2165.                 Debug 128 "Updating GRAPH   -> $frame_name\n"
  2166.                 if {![Debug 4 ""]} {
  2167.                     # if were not in static label debug mode
  2168.                     global Graph_Maxes Graph_Mins Graph_Scale Graph_Sort Graph_History
  2169.                     if {[info exists [set frame_name](COMMAND)] && \
  2170.                             [set [set frame_name](COMMAND)] != "" && \
  2171.                             ![Debug 4 ""]} {
  2172.                         # if there is a COMMAND for this group
  2173.                         foreach command \{[set [set frame_name](COMMAND)]\} {
  2174.                             append command_out [MyCatch "exec sh -c [list $command]" \
  2175.                                     "Warning: could not execute COMMAND ``$command'' in \
  2176.                                     ``$frame_name''."]
  2177.                         }
  2178.                     }
  2179.                     unset Graph_Sort
  2180.                     set Graph_Sort(dummy) ""
  2181.                     # unscale from previous time
  2182.                     eval ".$frame_name scale all 0 0 $Graph_Scale($frame_name)"
  2183.                     set old_max $Graph_Maxes($frame_name)
  2184.                     set old_min $Graph_Mins($frame_name)
  2185.                     set history [set [set frame_name](HISTORY)]
  2186.                     set direction [set [set frame_name](DIRECTION)]
  2187.                     set width [set [set frame_name](WIDTH)]
  2188.                     set height [set [set frame_name](HEIGHT)]
  2189.                     UpdatePlot $frame_name $command_out
  2190.                     # if we're actually getting numbers
  2191.                     if {[info exists Graph_Sort(solid)]} {
  2192.                         # if there were solid lines
  2193.                         foreach item [lsort -command AbsSort $Graph_Sort(solid)] {
  2194.                             # lower it to bottom
  2195.                             .$frame_name lower [lindex $item 1]
  2196.                         }
  2197.                     }
  2198.                     if {[info exists Graph_Sort(lined)]} {
  2199.                         # if there were lined linse
  2200.                         foreach item [lsort -command AbsSort $Graph_Sort(lined)] {
  2201.                             # raise it to top
  2202.                             .$frame_name raise [lindex $item 1]
  2203.                         }
  2204.                     }
  2205.                     if {[llength $Graph_History($frame_name)] > $history} {
  2206.                         # if we're over history
  2207.                         set leaving_max [lindex [lindex $Graph_History($frame_name) 0] 0]
  2208.                         set leaving_min [lindex [lindex $Graph_History($frame_name) 0] 1]
  2209.                         set leaving_group [lindex [lindex $Graph_History($frame_name) 0] 2]
  2210.                         # forget the one who is leaving
  2211.                         set Graph_History($frame_name) [lrange $Graph_History($frame_name) 1 end]
  2212.                         # delete everyone who's leaving
  2213.                         eval .$frame_name delete $leaving_group
  2214.                         set local_max 0
  2215.                         set local_min 0
  2216.                         if {$leaving_max >= $Graph_Maxes($frame_name) || \
  2217.                                 $leaving_min <= $Graph_Mins($frame_name)} {
  2218.                             # if leaving was a max or min
  2219.                             foreach old_one $Graph_History($frame_name) {
  2220.                                 # go through everyone still left
  2221.                                 if {[lindex $old_one 0] > $local_max} {
  2222.                                     set local_max [lindex $old_one 0]
  2223.                                 }
  2224.                                 if {[lindex $old_one 1] < $local_min} {
  2225.                                     set local_min [lindex $old_one 1]
  2226.                                 }
  2227.                             }
  2228.                             set Graph_Maxes($frame_name) $local_max
  2229.                             set Graph_Mins($frame_name) $local_min
  2230.                         }
  2231.                     }
  2232.                     # find new scale values depending on max or mins from above
  2233.                     switch $direction {
  2234.                         up -
  2235.                         down {
  2236.                             set yscale 1
  2237.                             if {[set g_width [expr double($Graph_Maxes($frame_name) - \
  2238.                                     $Graph_Mins($frame_name))]] == 0} {
  2239.                                 # if no width then no change
  2240.                                 set xscale 1
  2241.                             } else {
  2242.                                 set xscale [expr double(($width - 2) / $g_width)]
  2243.                                 set Graph_Scale($frame_name) "[expr 1.0 / $xscale] 1.0"
  2244.                             }
  2245.                             .$frame_name xview moveto 0
  2246.                             .$frame_name xview scroll \
  2247.                                     [expr 1 - [set [set frame_name](WIDTH)] - \
  2248.                                     int($Graph_Mins($frame_name) * $xscale)] units
  2249.                         }
  2250.                         left -
  2251.                         right {
  2252.                             set xscale 1
  2253.                             if {[set g_height [expr double($Graph_Maxes($frame_name) - \
  2254.                                     $Graph_Mins($frame_name))]] == 0} {
  2255.                                 # if no height then no change
  2256.                                 set yscale 1
  2257.                             } else {
  2258.                                 set yscale [expr ($height - 2) / $g_height]
  2259.                                 set Graph_Scale($frame_name) "1.0 [expr 1.0 / $yscale]"
  2260.                             }
  2261.                             .$frame_name yview moveto 0
  2262.                             .$frame_name yview scroll \
  2263.                                     [expr 1 - [set [set frame_name](HEIGHT)] - \
  2264.                                     int($Graph_Mins($frame_name) * $yscale)] units
  2265.                         }
  2266.                     }
  2267.                     .$frame_name scale all 0 0 $xscale $yscale
  2268.                 }
  2269.                 Debug 128 "Finished GRAPH   <- $frame_name\n"
  2270.                 set Times($frame_name) [expr $Elapsed_Seconds + [set [set frame_name](UPDATE)]]
  2271.             } else {
  2272.                 Blurb "This message should never be seen (3)!" 0
  2273.             }
  2274.         }
  2275.     }
  2276. }
  2277.  
  2278. ### END UpdateWidgets
  2279. #####################
  2280.  
  2281.  
  2282. #####################################
  2283. ### Update all PLOT lines in a GRAPH.
  2284.  
  2285. proc UpdatePlot { variable command_out } {
  2286.     global [set variable] Graph_Last Graph_Scale Graph_Maxes Graph_Mins Graph_Sort Graph_History
  2287.     # just in case there aren't any PLOTs in this GRAPH
  2288.     set plot_list ""
  2289.     # init these for first use
  2290.     set local_max 0
  2291.     set local_min 0
  2292.     set graph_group ""
  2293.     foreach item [array names $variable] {
  2294.         if {[string tolower $item] == $item} {
  2295.             # if it is a PLOT name
  2296.             lappend plot_list $item
  2297.         }
  2298.     }
  2299.     foreach item $plot_list {
  2300.         # go through the PLOTs
  2301.         global [set variable].[set item]
  2302.         Debug 128 "Updated PLOT     >---< $variable.[set [set variable].[set item](NAME)]\n"
  2303.         set color [set [set variable].[set item](COLOR)]
  2304.         set type [set [set variable].[set item](TYPE)]
  2305.         set height [set [set variable](HEIGHT)]
  2306.         set width [set [set variable](WIDTH)]
  2307.         set direction [set [set variable](DIRECTION)]
  2308.         if {[info exists [set variable].[set item](EXPRESSION)]} {
  2309.             set value [EvalSpecial [set [set variable].[set item](EXPRESSION)] \
  2310.                     $command_out $variable.$item]
  2311.         }    
  2312.         if {[set [set variable]($item)] != 1} {
  2313.             set color ""
  2314.         }
  2315.         if {![catch "expr $value + 1"]} {
  2316.             # if it's a number
  2317.             if {$value > $local_max} {
  2318.                 set local_max $value
  2319.             }
  2320.             if {$value < $local_min} {
  2321.                 set local_min $value
  2322.             }
  2323.             if {$value > $Graph_Maxes($variable)} {
  2324.                 set Graph_Maxes($variable) $value
  2325.                 ReHash $variable $height $width $direction [set [set variable](HISTORY)] \
  2326.                         [set [set variable](HASHES)] [set [set variable](ZEROCOL)] \
  2327.                         [set [set variable](HASHCOL)]
  2328.             }
  2329.             if {$value < $Graph_Mins($variable)} {
  2330.                 set Graph_Mins($variable) $value
  2331.                 ReHash $variable $height $width $direction [set [set variable](HISTORY)] \
  2332.                         [set [set variable](HASHES)] [set [set variable](ZEROCOL)] \
  2333.                         [set [set variable](HASHCOL)]
  2334.             }
  2335.             if {![info exists Graph_Last] || \
  2336.                     ![info exists Graph_Last($variable.$item)]} {
  2337.                 # find point plotted last time
  2338.                 set Graph_Last($variable.$item) $value
  2339.             }
  2340.             switch $direction {
  2341.                 up -
  2342.                 down {
  2343.                     if {$direction == "up"} {
  2344.                         set y1 [expr $height - 1]
  2345.                         set y2_lined [expr $height - 2]
  2346.                         set ymove -1
  2347.                     } else {
  2348.                         set y1 0
  2349.                         set y2_lined 1
  2350.                         set ymove 1
  2351.                     }
  2352.                     set x1 [expr -$value]
  2353.                     if {$type == "solid"} {
  2354.                         set y2 $y1
  2355.                         set x2 0
  2356.                     } else {
  2357.                         set y2 $y2_lined
  2358.                         set x2 [expr -$Graph_Last($variable.$item)]
  2359.                     }
  2360.                     # remember this value for next time
  2361.                     set Graph_Last($variable.$item) $value
  2362.                     set xmove 0
  2363.                 }
  2364.                 left -
  2365.                 right {
  2366.                     if {$direction == "left"} {
  2367.                         set x1 [expr $width - 1]
  2368.                         set x2_lined [expr $width - 2]
  2369.                         set xmove -1
  2370.                     } else {
  2371.                         set x1 0
  2372.                         set x2_lined 1
  2373.                         set xmove 1
  2374.                     }
  2375.                     set y1 [expr -$value]
  2376.                     if {$type == "solid"} {
  2377.                         set x2 $x1
  2378.                         set y2 0
  2379.                     } else {
  2380.                         set x2 $x2_lined
  2381.                         set y2 [expr -$Graph_Last($variable.$item)]
  2382.                     }
  2383.                     # remember this value for next time
  2384.                     set Graph_Last($variable.$item) $value
  2385.                     set ymove 0
  2386.                 }
  2387.             }
  2388.             .$variable move $item $xmove $ymove
  2389.             set temp [.$variable create line $x1 $y1 $x2 $y2 \
  2390.                     -fill $color -tags $item -capstyle round]
  2391.             lappend Graph_Sort($type) "$value $temp"
  2392.             lappend graph_group $temp
  2393.         }
  2394.     }
  2395.     # remember extremes
  2396.     lappend Graph_History($variable) "$local_max $local_min \{$graph_group\}"
  2397. }
  2398.  
  2399.  
  2400. ### END UpdatePlot
  2401. ##################
  2402.  
  2403.  
  2404. ###############################################################
  2405. ### Evaluate the special symbols in a dynamic label or a graph.
  2406.  
  2407. proc EvalSpecial { symbols output frame_name } {
  2408.     # The following special symbols exist:
  2409.     # $n - n is a integer - gives the nth field
  2410.     # %n - n is a integer - gives the nth field starting the last field
  2411.     # $n{$m} | $n{%m} | %n{$m} | %n{%m} - n and m are integers - get the mth field out of the
  2412.     #            nth field.  Assumes the nth field was enclosed in {}.
  2413.     # =$n | =%n - n is a integer - gives the nth field from the previous run of this command
  2414.     # :$n$m | :$n%m | :%n$m | :%n%m - n and m are integers - gives the range of fields from n to m
  2415.     # |c - c is a character - will replace every instance of character c with a space
  2416.     # 's' - s is a string - will return the result of the regexp s
  2417.     global Last_Output Times Last_Time Elapsed_Seconds
  2418.     if {![Debug 4 ""]} {
  2419.         foreach piece $symbols {
  2420.             # for each part of the math equation
  2421.             # check the first character
  2422.             switch -- [string index $piece 0] {
  2423.                 "$" {
  2424.                     if {[string index $piece 1] == "s"} {
  2425.                         # if it is "$s"
  2426.                         # find the last seconds delta
  2427.                         set piece [expr $Elapsed_Seconds - $Last_Time($frame_name)]
  2428.                         set Last_Time($frame_name) $Elapsed_Seconds
  2429.                     } elseif {[string index $piece [expr [string length $piece] - 1]] == "\}"} {
  2430.                         # else if has a {...}
  2431.                         set part [string trimleft [string range $piece 0 [expr \
  2432.                                 [string first "\{" $piece] - 1]] "\$"]
  2433.                         if {![catch "expr $part + 1"]} {
  2434.                             # if it's a number
  2435.                             set new_symbols [string trim [string range $piece \
  2436.                                     [string first "\{" $piece] end] "\{\}"]
  2437.                             set piece [EvalSpecial $new_symbols [lindex $output $part] \
  2438.                                     $frame_name]
  2439.                         }
  2440.                     } else {
  2441.                         # else it's a normal $n
  2442.                         set inx [string trimleft $piece \$]
  2443.                         if {![catch "expr $inx + 1"]} {
  2444.                             # if it's a number
  2445.                             # find what the $number points to
  2446.                             set piece [lindex $output $inx]
  2447.                         }
  2448.                     }
  2449.                 }
  2450.                 "%" {
  2451.                     if {[string index $piece 1] == "s"} {
  2452.                         # if it is "%s"
  2453.                         # find the last seconds delta
  2454.                         set piece [expr $Elapsed_Seconds - $Last_Time($frame_name)]
  2455.                         set Last_Time($frame_name) $Elapsed_Seconds
  2456.                     } elseif {[string index $piece [expr [string length $piece] - 1]] == "\}"} {
  2457.                         # else if has a {...}
  2458.                         set part [string trimleft [string range $piece 0 [expr \
  2459.                                 [string first "\{" $piece] - 1]] "%"]
  2460.                         if {![catch "expr $part + 1"]} {
  2461.                             # if it's a number
  2462.                             set new_symbols [string trim [string range $piece \
  2463.                                     [string first "\{" $piece] end] "\{\}"]
  2464.                             set piece [EvalSpecial $new_symbols [lindex $output \
  2465.                                 [expr [llength $output] - ($part + 1)]] $frame_name]
  2466.                         }
  2467.                     } else {
  2468.                         # else it's a normal %n
  2469.                         set inx [string trimleft $piece %]
  2470.                         if {![catch "expr $inx + 1"]} {
  2471.                             # if it's a number
  2472.                             # find field from right
  2473.                             set piece [lindex $output [expr [llength $output] - ($inx + 1)]]
  2474.                         }
  2475.                     }
  2476.                 }
  2477.                 ":" {
  2478.                     set trim [string trimleft $piece ":"]
  2479.                     set split [split [string trimleft $trim "\$%"] "\$%"]
  2480.                     set num1 [lindex $split 0]
  2481.                     set num2 [lindex $split 1]
  2482.                     if {![catch "expr $num1 + $num2"]} {
  2483.                         # if both are numbers
  2484.                         if {[string index $trim 0] == "\$"} {
  2485.                             set b $num1
  2486.                         } elseif {[string index $trim 0] == "%"} {
  2487.                             set b [expr [llength $output] - $num1]
  2488.                         }
  2489.                         if {[string first "\$" [string trimleft $trim "\$%"]] != -1} {
  2490.                             set e $num2
  2491.                         } elseif {[string first "%" [string trimleft $trim "\$%"]] != -1} {
  2492.                             set e [expr [llength $output] - ($num2 + 1)]
  2493.                         }
  2494.                         if {[info exists b] && [info exists e]} {
  2495.                             set piece [lrange $output $b $e]
  2496.                         }
  2497.                     }
  2498.                 }
  2499.                 "|" {
  2500.                     # can't just use Tcl's split because that'll create null fields if two \
  2501.                             split chars back to back.
  2502.                     set each_char [split $output {}]
  2503.                     set output ""
  2504.                     foreach char $each_char {
  2505.                         if {$char != [string index $piece 1]} {
  2506.                             append output $char
  2507.                         } else {
  2508.                             append output " "
  2509.                         }
  2510.                     }
  2511.                     set piece ""
  2512.                 }
  2513.                 "=" {
  2514.                     set trim [string trimleft $piece "="]
  2515.                     # recurse to next piece
  2516.                     if {[info exists Last_Output($frame_name)]} {
  2517.                         set piece [EvalSpecial $trim $Last_Output($frame_name) $frame_name]
  2518.                     }
  2519.                     # remember old output
  2520.                     set Last_Output($frame_name) $output
  2521.                 }
  2522.                 "'" {
  2523.                     set exp [string range $piece 1 [expr [string length $piece] - 2]]
  2524.                     set findings ""
  2525.                     set result [regexp $exp $output findings]
  2526.                     set output $findings
  2527.                     set piece ""
  2528.                 }
  2529.             }
  2530.             append math $piece
  2531.         }
  2532.         if {[catch "expr $math" result]} {
  2533.             # if parsing the equation fails
  2534.             set return_val $math
  2535.         } else {
  2536.             set return_val $result
  2537.         }
  2538.     } else {
  2539.         # else is debug level 4
  2540.         set return_val $symbols
  2541.     }
  2542.     return $return_val
  2543. }
  2544.  
  2545. ### END EvalSpecial
  2546. ###################
  2547.  
  2548.  
  2549.  
  2550. ################
  2551. ################
  2552. ### Graphics ###
  2553. ################
  2554. ################
  2555.  
  2556. ################################################
  2557. ### Scroll the graph with the left mouse button.
  2558.  
  2559. proc ScrollCanvas { frame_name type direction width height history x y } {
  2560.     set bw [lindex [$frame_name config -borderwidth] 4]
  2561.     switch $direction {
  2562.         up {
  2563.             # mark or dragto the new y position
  2564.             $frame_name scan $type 0 $y
  2565.             if {[$frame_name canvasy 0] > [expr 0 - $bw]} {
  2566.                 # if it dragged too far up
  2567.                 $frame_name yview moveto 0
  2568.             }
  2569.             if {[$frame_name canvasy 0] < [expr $height - $history - $bw]} {
  2570.                 # if it dragged too far down
  2571.                 $frame_name yview moveto 0        
  2572.                 $frame_name yview scroll [expr $height - $history] units
  2573.             }
  2574.         }
  2575.         down {
  2576.             # mark or dragto the new y position
  2577.             $frame_name scan $type 0 $y
  2578.             if {[$frame_name canvasy 0] < [expr 0 - $bw]} {
  2579.                 # if we dragged too far down
  2580.                 $frame_name yview moveto 0
  2581.                 $frame_name scan mark 0 $y
  2582.             }
  2583.             if {[$frame_name canvasy 0] > [expr $history - $height - $bw]} {
  2584.                 # if we dragged too far up
  2585.                 $frame_name yview moveto 0
  2586.                 $frame_name yview scroll [expr $history - $height] units
  2587.                 $frame_name scan mark 0 $y
  2588.             }
  2589.         }
  2590.         left {
  2591.             # mark or dragto the new x position
  2592.             $frame_name scan $type $x 0
  2593.             if {[$frame_name canvasx 0] > [expr 0 - $bw]} {
  2594.                 # if we dragged too far left
  2595.                 $frame_name xview moveto 0
  2596.                 $frame_name scan mark $x 0
  2597.             }
  2598.             if {[$frame_name canvasx 0] < [expr $width - $history - $bw]} {
  2599.                 # if we dragged too far right
  2600.                 $frame_name xview moveto 0
  2601.                 $frame_name xview scroll [expr $width - $history] units
  2602.                 $frame_name scan mark $x 0
  2603.             }
  2604.         }
  2605.         right {
  2606.             # mark or dragto the new x position
  2607.             $frame_name scan $type $x 0
  2608.             if {[$frame_name canvasx 0] < [expr 0 - $bw]} {
  2609.                 # if we dragged too far right
  2610.                 $frame_name xview moveto 0
  2611.                 $frame_name scan mark $x 0
  2612.             }
  2613.             if {[$frame_name canvasx 0] > [expr $history - $width - $bw]} {
  2614.                 # if we dragged too far left
  2615.                 $frame_name xview moveto 0
  2616.                 $frame_name xview scroll [expr $history - $width] units
  2617.                 $frame_name scan mark $x 0
  2618.             }
  2619.         }
  2620.     }
  2621. }
  2622.  
  2623. ### END ScrollCanvas
  2624. ####################
  2625.  
  2626.  
  2627. ################################################
  2628. ### Redraw all hash marks to new scale of graph.
  2629.  
  2630. proc ReHash { frame_name height width direction history hash_value zero_color hash_color } {
  2631.     global Graph_Maxes Graph_Mins
  2632.     .$frame_name addtag below_hashes below hashes
  2633.     .$frame_name delete hashes
  2634.     if {$hash_value} {
  2635.         switch $direction {
  2636.             up -
  2637.             down {
  2638.                 if {$direction == "up"} {
  2639.                     set start_y [expr $height - $history]
  2640.                     set end_y $height
  2641.                 } else {
  2642.                     set start_y 0
  2643.                     set end_y $history
  2644.                 }
  2645.                 for {set hash $Graph_Mins($frame_name)} \
  2646.                         {$hash <= [expr $Graph_Maxes($frame_name) + $hash_value]} \
  2647.                         {set hash [expr $hash + $hash_value]} {
  2648.                     # for min val to max val
  2649.                     # find the val rounded to hash_val
  2650.                     set mark [expr -($hash - fmod($hash, $hash_value))]
  2651.                     if {$mark != 0} {
  2652.                         .$frame_name create line $mark $start_y $mark $end_y \
  2653.                                 -fill $hash_color -tags hashes
  2654.                     }
  2655.                 }
  2656.                 .$frame_name create line 0 $start_y 0 $end_y -fill $zero_color -tags hashes
  2657.             }
  2658.             left -
  2659.             right {
  2660.                 if {$direction == "left"} {
  2661.                     set start_x [expr $width - $history]
  2662.                     set end_x $width
  2663.                 } else {
  2664.                     set start_x 0
  2665.                     set end_x $history
  2666.                 }
  2667.                 for {set hash $Graph_Mins($frame_name)} \
  2668.                         {$hash <= [expr $Graph_Maxes($frame_name) + $hash_value]} \
  2669.                         {set hash [expr $hash + $hash_value]} {
  2670.                     # for min val to max val
  2671.                     # find the val rounded to hash_val
  2672.                     set mark [expr -($hash - fmod($hash, $hash_value))]
  2673.                     if {$mark != 0} {
  2674.                         .$frame_name create line $start_x $mark $end_x $mark \
  2675.                                 -fill $hash_color -tags hashes
  2676.                     }
  2677.                 }
  2678.                 .$frame_name create line $start_x 0 $end_x 0 -fill $zero_color -tags hashes
  2679.             }
  2680.         }
  2681.         if {[.$frame_name gettags below_hashes] != ""} {
  2682.             # if there was anything below hashes
  2683.             # put these hashes above them
  2684.             .$frame_name raise hashes below_hashes
  2685.             .$frame_name dtag below_hashes
  2686.         } else {
  2687.             # put these on the bottom
  2688.             .$frame_name raise hashes
  2689.         }
  2690.     }
  2691. }
  2692.  
  2693. ### END ReHash
  2694. ##############
  2695.  
  2696.  
  2697.  
  2698. #####################
  2699. #####################
  2700. ### Here we go... ###
  2701. #####################
  2702. #####################
  2703.  
  2704. InitAll
  2705.  
  2706. ### END OmniMoni
  2707. ################
  2708.  
  2709.  
  2710.  
  2711. ###################
  2712. ###################
  2713. ### Emacs Stuff ###
  2714. ###################
  2715. ###################
  2716. ### Emacs variables...
  2717. ###
  2718. ### Local Variables:
  2719. ### mode:tcl
  2720. ### tab-width:4
  2721. ### minormode:line-number
  2722. ### End:
  2723.